summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/pkg.test472
-rw-r--r--tests/platform.test1
-rw-r--r--tests/safe.test6
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}
generated by cgit v0.12 at 2024-11-16 08:11:02 (GMT)