diff options
author | andreas_kupries <akupries@shaw.ca> | 2006-09-22 01:26:21 (GMT) |
---|---|---|
committer | andreas_kupries <akupries@shaw.ca> | 2006-09-22 01:26:21 (GMT) |
commit | e071f14d95c6a3e37911f58a3ca71da73b6a72d2 (patch) | |
tree | 32acbff94cb87475dcf718f476fd8fb8e668cff2 /tests | |
parent | e54225009c1133029084660b54b930783c1fbb94 (diff) | |
download | tcl-e071f14d95c6a3e37911f58a3ca71da73b6a72d2.zip tcl-e071f14d95c6a3e37911f58a3ca71da73b6a72d2.tar.gz tcl-e071f14d95c6a3e37911f58a3ca71da73b6a72d2.tar.bz2 |
* generic/tcl.decls: Implemented TIP #268, conditionally.
* generic/tclBasic.c: Define TCL_TIP268 to activate the new
* generic/tclDecls.h: features.
* generic/tclInt.h:
* generic/tclPkg.c:
* generic/tclStubInit.c:
* generic/tclTest.c:
* library/init.tcl
* library/package.tcl:
* tests/pkg.test:
* tests/platform.test:
* tests/safe.test:
* doc/PkgRequire.3:
Diffstat (limited to 'tests')
-rw-r--r-- | tests/pkg.test | 472 | ||||
-rw-r--r-- | tests/platform.test | 1 | ||||
-rw-r--r-- | tests/safe.test | 6 |
3 files changed, 462 insertions, 17 deletions
diff --git a/tests/pkg.test b/tests/pkg.test index 83488a1..baea4d5 100644 --- a/tests/pkg.test +++ b/tests/pkg.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: pkg.test,v 1.9.12.4 2006/04/05 01:42:16 dgp Exp $ +# RCS: @(#) $Id: pkg.test,v 1.9.12.5 2006/09/22 01:26:24 andreas_kupries Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -31,6 +31,9 @@ package unknown {} set oldPath $auto_path set auto_path "" +testConstraint tip268 [info exists tcl_platform(tip,268)] +testConstraint !tip268 [expr {![info exists tcl_platform(tip,268)]}] + test pkg-1.1 {Tcl_PkgProvide procedure} { package forget t package provide t 2.3 @@ -56,6 +59,23 @@ test pkg-1.5 {Tcl_PkgProvide procedure} { package provide t 2.3 } {} +test pkg-1.6 {Tcl_PkgProvide procedure} tip268 { + package forget t + package provide t 2.3a1 +} {} + +set n 0 +foreach v { + 2.3k1 2a3a2 2ab3 2.a4 2.b4 2b.4 2a.4 2ba4 2a4b1 + 2b4a1 2b3b2 +} { + test pkg-1.7.$n {Tcl_PkgProvide procedure} tip268 { + package forget t + list [catch {package provide t $v} msg] $msg + } [list 1 "expected version number but got \"$v\""] + incr n +} + test pkg-2.1 {Tcl_PkgRequire procedure, picking best version} { package forget t foreach i {1.4 3.4 2.3 2.4 2.2} { @@ -117,14 +137,24 @@ test pkg-2.7 {Tcl_PkgRequire procedure, can't find suitable version} { } list [catch {package require t 4.1} msg] $msg } {1 {can't find package t 4.1}} -test pkg-2.8 {Tcl_PkgRequire procedure, can't find suitable version} { +test pkg-2.8 {Tcl_PkgRequire procedure, can't find suitable version} !tip268 { package forget t package unknown {} foreach i {1.4 3.4 2.3 2.4 2.2} { package ifneeded t $i "set x $i" } list [catch {package require -exact t 1.3} msg] $msg + } {1 {can't find package t 1.3}} +test pkg-2.8-268 {Tcl_PkgRequire procedure, can't find suitable version} tip268 { + package forget t + package unknown {} + foreach i {1.4 3.4 2.3 2.4 2.2} { + package ifneeded t $i "set x $i" + } + list [catch {package require -exact t 1.3} msg] $msg + +} {1 {can't find package t 1.3-1.4}} test pkg-2.9 {Tcl_PkgRequire procedure, can't find suitable version} { package forget t package unknown {} @@ -153,7 +183,7 @@ test pkg-2.12 {Tcl_PkgRequire procedure, self-deleting script} { package require t 1.2 set x } {1.2} -test pkg-2.13 {Tcl_PkgRequire procedure, "package unknown" support} { +test pkg-2.13-!268 {Tcl_PkgRequire procedure, "package unknown" support} !tip268 { proc pkgUnknown args { global x set x $args @@ -169,6 +199,26 @@ test pkg-2.13 {Tcl_PkgRequire procedure, "package unknown" support} { package unknown {} set x } {t 1.5 -exact} + +test pkg-2.13-268 {Tcl_PkgRequire procedure, "package unknown" support} tip268 { + proc pkgUnknown args { + # args = name requirement + # requirement = v-v (for exact version) + global x + set x $args + package provide [lindex $args 0] [lindex [split [lindex $args 1] -] 0] + } + package forget t + foreach i {1.4 3.4 2.3 2.4 2.2} { + package ifneeded t $i "set x $i" + } + package unknown pkgUnknown + set x xxx + package require -exact t 1.5 + package unknown {} + set x +} {t 1.5-1.6} + test pkg-2.14 {Tcl_PkgRequire procedure, "package unknown" support} { proc pkgUnknown args { package ifneeded t 1.2 "set x loaded; package provide t 1.2" @@ -180,7 +230,7 @@ test pkg-2.14 {Tcl_PkgRequire procedure, "package unknown" support} { package unknown {} set result } {1.2 loaded} -test pkg-2.15 {Tcl_PkgRequire procedure, "package unknown" support} { +test pkg-2.15 {Tcl_PkgRequire procedure, "package unknown" support} !tip268 { proc pkgUnknown args { global x set x $args @@ -193,7 +243,20 @@ test pkg-2.15 {Tcl_PkgRequire procedure, "package unknown" support} { package unknown {} set x } {{a b} {}} -test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} { +test pkg-2.15-268 {Tcl_PkgRequire procedure, "package unknown" support} tip268 { + proc pkgUnknown args { + global x + set x $args + package provide [lindex $args 0] 2.0 + } + package forget {a b} + package unknown pkgUnknown + set x xxx + package require {a b} + package unknown {} + set x +} {{a b}} +test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} !tip268 { proc pkgUnknown args { error "testing package unknown" } @@ -211,7 +274,25 @@ test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} { ("package unknown" script) invoked from within "package require t"}} -test pkg-2.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} { +test pkg-2.16-268 {Tcl_PkgRequire procedure, "package unknown" error} tip268 { + proc pkgUnknown args { + error "testing package unknown" + } + package forget t + package unknown pkgUnknown + set result [list [catch {package require t} msg] $msg $errorInfo] + package unknown {} + set result +} {1 {testing package unknown} {testing package unknown + while executing +"error "testing package unknown"" + (procedure "pkgUnknown" line 2) + invoked from within +"pkgUnknown t" + ("package unknown" script) + invoked from within +"package require t"}} +test pkg-2.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} !tip268 { proc pkgUnknown args { global x set x $args @@ -226,6 +307,21 @@ test pkg-2.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} package unknown {} set result } {1 {can't find package t 1.5} {t 1.5 -exact}} +test pkg-2.17-268 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} tip268 { + proc pkgUnknown args { + global x + set x $args + } + package forget t + foreach i {1.4 3.4 2.3 2.4 2.2} { + package ifneeded t $i "set x $i" + } + package unknown pkgUnknown + set x xxx + set result [list [catch {package require -exact t 1.5} msg] $msg $x] + package unknown {} + set result +} {1 {can't find package t 1.5-1.6} {t 1.5-1.6}} test pkg-2.18 {Tcl_PkgRequire procedure, version checks} { package forget t package provide t 2.3 @@ -256,11 +352,16 @@ test pkg-2.23 {Tcl_PkgRequire procedure, version checks} { package provide t 2.3 package require -exact t 2.3 } {2.3} -test pkg-2.24 {Tcl_PkgRequire procedure, version checks} { +test pkg-2.24 {Tcl_PkgRequire procedure, version checks} !tip268 { package forget t package provide t 2.3 list [catch {package require -exact t 2.2} msg] $msg } {1 {version conflict for package "t": have 2.3, need 2.2}} +test pkg-2.24-268 {Tcl_PkgRequire procedure, version checks} tip268 { + package forget t + package provide t 2.3 + list [catch {package require -exact t 2.2} msg] $msg +} {1 {version conflict for package "t": have 2.3, need 2.2-2.3}} test pkg-2.25 {Tcl_PkgRequire procedure, error in ifneeded script} -body { package forget t package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test" EI} @@ -466,6 +567,40 @@ test pkg-2.43 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package unknown $saveUnknown } -returnCodes error -match glob -result {bad return code:*} + + +test pkg-2.50 {Tcl_PkgRequire procedure, picking best stable version} tip268 { + package forget t + foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} { + package ifneeded t $i "set x $i; package provide t $i" + } + set x xxx + package require t + set x +} {3.4} + +test pkg-2.51 {Tcl_PkgRequire procedure, picking best stable version} tip268 { + package forget t + foreach i {1.2b1 1.2 1.3a2 1.3} { + package ifneeded t $i "set x $i; package provide t $i" + } + set x xxx + package require t + set x +} {1.3} + +test pkg-2.52 {Tcl_PkgRequire procedure, picking best stable version} tip268 { + package forget t + foreach i {1.2b1 1.2 1.3 1.3a2} { + package ifneeded t $i "set x $i; package provide t $i" + } + set x xxx + package require t + set x +} {1.3} + + + test pkg-3.1 {Tcl_PackageCmd procedure} { list [catch {package} msg] $msg } {1 {wrong # args: should be "package option ?arg arg ...?"}} @@ -589,16 +724,24 @@ test pkg-3.21 {Tcl_PackageCmd procedure, "provide" option} { package forget t list [catch {package provide t a.b} msg] $msg } {1 {expected version number but got "a.b"}} -test pkg-3.22 {Tcl_PackageCmd procedure, "require" option} { +test pkg-3.22 {Tcl_PackageCmd procedure, "require" option} !tip268 { list [catch {package require} msg] $msg } {1 {wrong # args: should be "package require ?-exact? package ?version?"}} -test pkg-3.23 {Tcl_PackageCmd procedure, "require" option} { +test pkg-3.22-268 {Tcl_PackageCmd procedure, "require" option} tip268 { + list [catch {package require} msg] $msg +} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}} +test pkg-3.23 {Tcl_PackageCmd procedure, "require" option} !tip268 { list [catch {package require a b c} msg] $msg } {1 {wrong # args: should be "package require ?-exact? package ?version?"}} -test pkg-3.24 {Tcl_PackageCmd procedure, "require" option} { +test pkg-3.24 {Tcl_PackageCmd procedure, "require" option} !tip268 { list [catch {package require -exact a b c} msg] $msg } {1 {wrong # args: should be "package require ?-exact? package ?version?"}} -test pkg-3.25 {Tcl_PackageCmd procedure, "require" option} { +test pkg-3.24-268 {Tcl_PackageCmd procedure, "require" option} tip268 { + list [catch {package require -exact a b c} msg] $msg + # Exact syntax: -exact name version + # name ?requirement...? +} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}} +test pkg-3.25 {Tcl_PackageCmd procedure, "require" option} !tip268 { list [catch {package require -bs a b} msg] $msg } {1 {wrong # args: should be "package require ?-exact? package ?version?"}} test pkg-3.26 {Tcl_PackageCmd procedure, "require" option} { @@ -607,12 +750,18 @@ test pkg-3.26 {Tcl_PackageCmd procedure, "require" option} { test pkg-3.27 {Tcl_PackageCmd procedure, "require" option} { list [catch {package require -exact x a.b} msg] $msg } {1 {expected version number but got "a.b"}} -test pkg-3.28 {Tcl_PackageCmd procedure, "require" option} { +test pkg-3.28 {Tcl_PackageCmd procedure, "require" option} !tip268 { list [catch {package require -exact x} msg] $msg } {1 {wrong # args: should be "package require ?-exact? package ?version?"}} -test pkg-3.29 {Tcl_PackageCmd procedure, "require" option} { +test pkg-3.28-268 {Tcl_PackageCmd procedure, "require" option} tip268 { + list [catch {package require -exact x} msg] $msg +} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}} +test pkg-3.29 {Tcl_PackageCmd procedure, "require" option} !tip268 { list [catch {package require -exact} msg] $msg } {1 {wrong # args: should be "package require ?-exact? package ?version?"}} +test pkg-3.29-268 {Tcl_PackageCmd procedure, "require" option} tip268 { + list [catch {package require -exact} msg] $msg +} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}} test pkg-3.30 {Tcl_PackageCmd procedure, "require" option} { package forget t package provide t 2.3 @@ -678,10 +827,13 @@ test pkg-3.46 {Tcl_PackageCmd procedure, "versions" option} { package ifneeded t 2.4 y package versions t } {2.3 2.4} -test pkg-3.47 {Tcl_PackageCmd procedure, "vsatisfies" option} { +test pkg-3.47 {Tcl_PackageCmd procedure, "vsatisfies" option} !tip268 { list [catch {package vsatisfies a} msg] $msg } {1 {wrong # args: should be "package vsatisfies version1 version2"}} -test pkg-3.48 {Tcl_PackageCmd procedure, "vsatisfies" option} { +test pkg-3.47-268 {Tcl_PackageCmd procedure, "vsatisfies" option} tip268 { + list [catch {package vsatisfies a} msg] $msg +} {1 {wrong # args: should be "package vsatisfies version requirement requirement..."}} +test pkg-3.48 {Tcl_PackageCmd procedure, "vsatisfies" option} !tip268 { list [catch {package vsatisfies a b c} msg] $msg } {1 {wrong # args: should be "package vsatisfies version1 version2"}} test pkg-3.49 {Tcl_PackageCmd procedure, "vsatisfies" option} { @@ -696,9 +848,24 @@ test pkg-3.51 {Tcl_PackageCmd procedure, "vsatisfies" option} { test pkg-3.52 {Tcl_PackageCmd procedure, "vsatisfies" option} { package vs 2.3 1.2 } {0} -test pkg-3.53 {Tcl_PackageCmd procedure, "versions" option} { +test pkg-3.53 {Tcl_PackageCmd procedure, "versions" option} !tip268 { list [catch {package foo} msg] $msg } {1 {bad option "foo": must be forget, ifneeded, names, present, provide, require, unknown, vcompare, versions, or vsatisfies}} +test pkg-3.53-268 {Tcl_PackageCmd procedure, "versions" option} tip268 { + list [catch {package foo} msg] $msg +} {1 {bad option "foo": must be forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies}} + +test pkg-3.54 {Tcl_PackageCmd procedure, "vsatisfies" option} tip268 { + list [catch {package vsatisfies 2.1 2.1-3.2-4.5} msg] $msg +} {1 {expected versionMin-versionMax but got "2.1-3.2-4.5"}} + +test pkg-3.55 {Tcl_PackageCmd procedure, "vsatisfies" option} tip268 { + list [catch {package vsatisfies 2.1 3.2-x.y} msg] $msg +} {1 {expected version number but got "x.y"}} + +test pkg-3.56 {Tcl_PackageCmd procedure, "vsatisfies" option} tip268 { + list [catch {package vsatisfies 2.1 x.y-3.2} msg] $msg +} {1 {expected version number but got "x.y"}} # No tests for FindPackage; can't think up anything detectable # errors. @@ -845,6 +1012,279 @@ test pkg-7.18 {Tcl_PackageCmd procedure, "present" option} { list [catch {package present -exact} msg] $msg } {1 {wrong # args: should be "package present ?-exact? package ?version?"}} + +set n 0 +foreach {r p vs vc} { + 8.5a0 8.5a5 1 -1 + 8.5a0 8.5b1 1 -1 + 8.5a0 8.5.1 1 -1 + 8.5a0 8.6a0 1 -1 + 8.5a0 8.6b0 1 -1 + 8.5a0 8.6.0 1 -1 + 8.5a6 8.5a5 0 1 + 8.5a6 8.5b1 1 -1 + 8.5a6 8.5.1 1 -1 + 8.5a6 8.6a0 1 -1 + 8.5a6 8.6b0 1 -1 + 8.5a6 8.6.0 1 -1 + 8.5b0 8.5a5 0 1 + 8.5b0 8.5b1 1 -1 + 8.5b0 8.5.1 1 -1 + 8.5b0 8.6a0 1 -1 + 8.5b0 8.6b0 1 -1 + 8.5b0 8.6.0 1 -1 + 8.5b2 8.5a5 0 1 + 8.5b2 8.5b1 0 1 + 8.5b2 8.5.1 1 -1 + 8.5b2 8.6a0 1 -1 + 8.5b2 8.6b0 1 -1 + 8.5b2 8.6.0 1 -1 + 8.5 8.5a5 1 1 + 8.5 8.5b1 1 1 + 8.5 8.5.1 1 -1 + 8.5 8.6a0 1 -1 + 8.5 8.6b0 1 -1 + 8.5 8.6.0 1 -1 + 8.5.0 8.5a5 0 1 + 8.5.0 8.5b1 0 1 + 8.5.0 8.5.1 1 -1 + 8.5.0 8.6a0 1 -1 + 8.5.0 8.6b0 1 -1 + 8.5.0 8.6.0 1 -1 +} { + test package-vsatisfies-1.$n {package vsatisfies} tip268 { + package vsatisfies $p $r + } $vs + + test package-vcompare-1.$n {package vcompare} tip268 { + package vcompare $r $p + } $vc + + incr n +} + +set n 0 +foreach {required provided satisfied} { + 8.5a0- 8.5a5 1 + 8.5a0- 8.5b1 1 + 8.5a0- 8.5.1 1 + 8.5a0- 8.6a0 1 + 8.5a0- 8.6b0 1 + 8.5a0- 8.6.0 1 + 8.5a6- 8.5a5 0 + 8.5a6- 8.5b1 1 + 8.5a6- 8.5.1 1 + 8.5a6- 8.6a0 1 + 8.5a6- 8.6b0 1 + 8.5a6- 8.6.0 1 + 8.5b0- 8.5a5 0 + 8.5b0- 8.5b1 1 + 8.5b0- 8.5.1 1 + 8.5b0- 8.6a0 1 + 8.5b0- 8.6b0 1 + 8.5b0- 8.6.0 1 + 8.5b2- 8.5a5 0 + 8.5b2- 8.5b1 0 + 8.5b2- 8.5.1 1 + 8.5b2- 8.6a0 1 + 8.5b2- 8.6b0 1 + 8.5b2- 8.6.0 1 + 8.5- 8.5a5 1 + 8.5- 8.5b1 1 + 8.5- 8.5.1 1 + 8.5- 8.6a0 1 + 8.5- 8.6b0 1 + 8.5- 8.6.0 1 + 8.5.0- 8.5a5 0 + 8.5.0- 8.5b1 0 + 8.5.0- 8.5.1 1 + 8.5.0- 8.6a0 1 + 8.5.0- 8.6b0 1 + 8.5.0- 8.6.0 1 + 8.5a0-7 8.5a5 0 + 8.5a0-7 8.5b1 0 + 8.5a0-7 8.5.1 0 + 8.5a0-7 8.6a0 0 + 8.5a0-7 8.6b0 0 + 8.5a0-7 8.6.0 0 + 8.5a6-7 8.5a5 0 + 8.5a6-7 8.5b1 0 + 8.5a6-7 8.5.1 0 + 8.5a6-7 8.6a0 0 + 8.5a6-7 8.6b0 0 + 8.5a6-7 8.6.0 0 + 8.5b0-7 8.5a5 0 + 8.5b0-7 8.5b1 0 + 8.5b0-7 8.5.1 0 + 8.5b0-7 8.6a0 0 + 8.5b0-7 8.6b0 0 + 8.5b0-7 8.6.0 0 + 8.5b2-7 8.5a5 0 + 8.5b2-7 8.5b1 0 + 8.5b2-7 8.5.1 0 + 8.5b2-7 8.6a0 0 + 8.5b2-7 8.6b0 0 + 8.5b2-7 8.6.0 0 + 8.5-7 8.5a5 0 + 8.5-7 8.5b1 0 + 8.5-7 8.5.1 0 + 8.5-7 8.6a0 0 + 8.5-7 8.6b0 0 + 8.5-7 8.6.0 0 + 8.5.0-7 8.5a5 0 + 8.5.0-7 8.5b1 0 + 8.5.0-7 8.5.1 0 + 8.5.0-7 8.6a0 0 + 8.5.0-7 8.6b0 0 + 8.5.0-7 8.6.0 0 + 8.5a0-8.6.1 8.5a5 1 + 8.5a0-8.6.1 8.5b1 1 + 8.5a0-8.6.1 8.5.1 1 + 8.5a0-8.6.1 8.6a0 1 + 8.5a0-8.6.1 8.6b0 1 + 8.5a0-8.6.1 8.6.0 1 + 8.5a6-8.6.1 8.5a5 0 + 8.5a6-8.6.1 8.5b1 1 + 8.5a6-8.6.1 8.5.1 1 + 8.5a6-8.6.1 8.6a0 1 + 8.5a6-8.6.1 8.6b0 1 + 8.5a6-8.6.1 8.6.0 1 + 8.5b0-8.6.1 8.5a5 0 + 8.5b0-8.6.1 8.5b1 1 + 8.5b0-8.6.1 8.5.1 1 + 8.5b0-8.6.1 8.6a0 1 + 8.5b0-8.6.1 8.6b0 1 + 8.5b0-8.6.1 8.6.0 1 + 8.5b2-8.6.1 8.5a5 0 + 8.5b2-8.6.1 8.5b1 0 + 8.5b2-8.6.1 8.5.1 1 + 8.5b2-8.6.1 8.6a0 1 + 8.5b2-8.6.1 8.6b0 1 + 8.5b2-8.6.1 8.6.0 1 + 8.5-8.6.1 8.5a5 1 + 8.5-8.6.1 8.5b1 1 + 8.5-8.6.1 8.5.1 1 + 8.5-8.6.1 8.6a0 1 + 8.5-8.6.1 8.6b0 1 + 8.5-8.6.1 8.6.0 1 + 8.5.0-8.6.1 8.5a5 0 + 8.5.0-8.6.1 8.5b1 0 + 8.5.0-8.6.1 8.5.1 1 + 8.5.0-8.6.1 8.6a0 1 + 8.5.0-8.6.1 8.6b0 1 + 8.5.0-8.6.1 8.6.0 1 + 8.5a0-8.5a0 8.5a0 1 + 8.5a0-8.5a0 8.5b1 0 + 8.5a0-8.5a0 8.4 0 + 8.5b0-8.5b0 8.5a5 0 + 8.5b0-8.5b0 8.5b0 1 + 8.5b0-8.5b0 8.5.1 0 + 8.5-8.5 8.5a5 0 + 8.5-8.5 8.5b1 0 + 8.5-8.5 8.5 1 + 8.5-8.5 8.5.1 0 + 8.5.0-8.5.0 8.5a5 0 + 8.5.0-8.5.0 8.5b1 0 + 8.5.0-8.5.0 8.5.0 1 + 8.5.0-8.5.0 8.5.1 0 + 8.5.0-8.5.0 8.6a0 0 + 8.5.0-8.5.0 8.6b0 0 + 8.5.0-8.5.0 8.6.0 0 + 8.2 9 0 + 8.2- 9 1 + 8.2-8.5 9 0 + 8.2-9.1 9 1 + + 8.5-8.5 8.5b1 0 + 8.5a0-8.5 8.5b1 0 + 8.5a0-8.5.1 8.5b1 1 + + 8.5-8.5 8.5 1 + 8.5.0-8.5.0 8.5 1 + 8.5a0-8.5.0 8.5 0 + +} { + test package-vsatisfies-2.$n "package vsatisfies $provided $required" tip268 { + package vsatisfies $provided $required + } $satisfied + incr n +} + +test package-vsatisfies-3.0 "package vsatisfies multiple" tip268 { + # yes no + package vsatisfies 8.4 8.4 7.3 +} 1 + +test package-vsatisfies-3.1 "package vsatisfies multiple" tip268 { + # no yes + package vsatisfies 8.4 7.3 8.4 +} 1 + +test package-vsatisfies-3.2 "package vsatisfies multiple" tip268 { + # yes yes + package vsatisfies 8.4.2 8.4 8.4.1 +} 1 + +test package-vsatisfies-3.3 "package vsatisfies multiple" tip268 { + # no no + package vsatisfies 8.4 7.3 6.1 +} 0 + + +proc prefer {args} { + set ip [interp create] + lappend res [$ip eval {package prefer}] + foreach mode $args { + lappend res [$ip eval [list package prefer $mode]] + } + interp delete $ip + return $res +} + +test package-prefer-1.0 {default} tip268 { + prefer +} stable + +test package-prefer-1.1 {default} tip268 { + set ::env(TCL_PKG_PREFER_LATEST) stable ; # value not relevant! + set res [prefer] + unset ::env(TCL_PKG_PREFER_LATEST) + set res +} latest + +test package-prefer-2.0 {wrong\#args} tip268 { + catch {package prefer foo bar} msg + set msg +} {wrong # args: should be "package prefer ?latest|stable?"} + +test package-prefer-2.1 {bogus argument} tip268 { + catch {package prefer foo} msg + set msg +} {bad preference "foo": must be latest or stable} + +test package-prefer-3.0 {set, keep} tip268 { + package prefer stable +} stable + +test package-prefer-3.1 {set stable, keep} tip268 { + prefer stable +} {stable stable} + +test package-prefer-3.2 {set latest, change} tip268 { + prefer latest +} {stable latest} + +test package-prefer-3.3 {set latest, keep} tip268 { + prefer latest latest +} {stable latest latest} + +test package-prefer-3.3 {set stable, rejected} tip268 { + prefer latest stable +} {stable latest latest} + +rename prefer {} + + set auto_path $oldPath package unknown $oldPkgUnknown concat diff --git a/tests/platform.test b/tests/platform.test index f9d7aca..01bf787 100644 --- a/tests/platform.test +++ b/tests/platform.test @@ -22,6 +22,7 @@ test platform-1.1 {TclpSetVariables: tcl_platform} { interp create i i eval {catch {unset tcl_platform(debug)}} i eval {catch {unset tcl_platform(threaded)}} + i eval {catch {unset tcl_platform(tip,268)}} set result [i eval {lsort [array names tcl_platform]}] interp delete i set result diff --git a/tests/safe.test b/tests/safe.test index a26cb92..15dfa85 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: safe.test,v 1.13.2.1 2005/06/22 16:02:42 dgp Exp $ +# RCS: @(#) $Id: safe.test,v 1.13.2.2 2006/09/22 01:26:24 andreas_kupries Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -187,6 +187,10 @@ test safe-6.3 {test safe interpreters knowledge of the world} { if {$threaded != -1} { set r [lreplace $r $threaded $threaded] } + set tip [lsearch $r "tip,268"] + if {$tip != -1} { + set r [lreplace $r $tip $tip] + } set r } {byteOrder platform wordSize} |