summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorandreas_kupries <akupries@shaw.ca>2006-09-22 18:13:25 (GMT)
committerandreas_kupries <akupries@shaw.ca>2006-09-22 18:13:25 (GMT)
commit4d806ec7125d35e4f837f3a2274aedc0f7593954 (patch)
treef67d58798c4d5ba6ee60a07d1f99fe77001dee13 /tests
parent881fdb141e92e3ea0b7b72197ad32d992f78195c (diff)
downloadtcl-4d806ec7125d35e4f837f3a2274aedc0f7593954.zip
tcl-4d806ec7125d35e4f837f3a2274aedc0f7593954.tar.gz
tcl-4d806ec7125d35e4f837f3a2274aedc0f7593954.tar.bz2
TIP#268 IMPLEMENTATION
* generic/tclDecls.h: Regenerated from tcl.decls. * generic/tclStubInit.c: * doc/PkgRequire.3: Documentation of extended API, * doc/package.n: extended testsuite. * tests/pkg.test: * generic/tcl.decls: Implementation. * generic/tclBasic.c: * generic/tclConfig.c: * generic/tclInt.h: * generic/tclPkg.c: * generic/tclTest.c: * generic/tclTomMathInterface.c: * library/init.tcl: * library/package.tcl: * library/tm.tcl:
Diffstat (limited to 'tests')
-rw-r--r--tests/pkg.test383
1 files changed, 360 insertions, 23 deletions
diff --git a/tests/pkg.test b/tests/pkg.test
index 31091bb..5f78f2f 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.16 2005/12/02 17:34:03 dgp Exp $
+# RCS: @(#) $Id: pkg.test,v 1.17 2006/09/22 18:13:30 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -56,6 +56,23 @@ test pkg-1.5 {Tcl_PkgProvide procedure} {
package provide t 2.3
} {}
+test pkg-1.6 {Tcl_PkgProvide procedure} {
+ 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} {
+ 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} {
@@ -124,7 +141,7 @@ test pkg-2.8 {Tcl_PkgRequire procedure, can't find suitable version} {
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 {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 {}
@@ -155,9 +172,11 @@ test pkg-2.12 {Tcl_PkgRequire procedure, self-deleting script} {
} {1.2}
test pkg-2.13 {Tcl_PkgRequire procedure, "package unknown" support} {
proc pkgUnknown args {
+ # args = name requirement
+ # requirement = v-v (for exact version)
global x
set x $args
- package provide [lindex $args 0] [lindex $args 1]
+ 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} {
@@ -168,7 +187,7 @@ test pkg-2.13 {Tcl_PkgRequire procedure, "package unknown" support} {
package require -exact t 1.5
package unknown {}
set x
-} {t 1.5 -exact}
+} {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"
@@ -192,7 +211,7 @@ test pkg-2.15 {Tcl_PkgRequire procedure, "package unknown" support} {
package require {a b}
package unknown {}
set x
-} {{a b} {}}
+} {{a b}}
test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} {
proc pkgUnknown args {
error "testing package unknown"
@@ -207,7 +226,7 @@ test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} {
"error "testing package unknown""
(procedure "pkgUnknown" line 2)
invoked from within
-"pkgUnknown t {}"
+"pkgUnknown t"
("package unknown" script)
invoked from within
"package require t"}}
@@ -225,7 +244,7 @@ test pkg-2.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package}
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} {t 1.5 -exact}}
+} {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
@@ -260,7 +279,7 @@ test pkg-2.24 {Tcl_PkgRequire procedure, version checks} {
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}}
+} {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}
@@ -463,6 +482,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} {
+ 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} {
+ 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} {
+ 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 ...?"}}
@@ -588,16 +641,14 @@ test pkg-3.21 {Tcl_PackageCmd procedure, "provide" option} {
} {1 {expected version number but got "a.b"}}
test pkg-3.22 {Tcl_PackageCmd procedure, "require" option} {
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} {
- list [catch {package require a b c} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
+} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}
+
test pkg-3.24 {Tcl_PackageCmd procedure, "require" option} {
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} {
- list [catch {package require -bs a b} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
+ # Exact syntax: -exact name version
+ # name ?requirement...?
+} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}
+
test pkg-3.26 {Tcl_PackageCmd procedure, "require" option} {
list [catch {package require x a.b} msg] $msg
} {1 {expected version number but got "a.b"}}
@@ -606,10 +657,10 @@ test pkg-3.27 {Tcl_PackageCmd procedure, "require" option} {
} {1 {expected version number but got "a.b"}}
test pkg-3.28 {Tcl_PackageCmd procedure, "require" option} {
list [catch {package require -exact x} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
+} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}
test pkg-3.29 {Tcl_PackageCmd procedure, "require" option} {
list [catch {package require -exact} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
+} {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
@@ -677,10 +728,8 @@ test pkg-3.46 {Tcl_PackageCmd procedure, "versions" option} {
} {2.3 2.4}
test pkg-3.47 {Tcl_PackageCmd procedure, "vsatisfies" option} {
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} {
- list [catch {package vsatisfies a b c} msg] $msg
-} {1 {wrong # args: should be "package vsatisfies version1 version2"}}
+} {1 {wrong # args: should be "package vsatisfies version requirement requirement..."}}
+
test pkg-3.49 {Tcl_PackageCmd procedure, "vsatisfies" option} {
list [catch {package vsatisfies x.y 3.4} msg] $msg
} {1 {expected version number but got "x.y"}}
@@ -695,7 +744,20 @@ test pkg-3.52 {Tcl_PackageCmd procedure, "vsatisfies" option} {
} {0}
test pkg-3.53 {Tcl_PackageCmd procedure, "versions" option} {
list [catch {package foo} msg] $msg
-} {1 {bad option "foo": must be forget, ifneeded, names, present, provide, require, unknown, vcompare, versions, or vsatisfies}}
+} {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} {
+ 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} {
+ 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} {
+ 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.
@@ -842,6 +904,281 @@ 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} {
+ package vsatisfies $p $r
+ } $vs
+
+ test package-vcompare-1.$n {package vcompare} {
+ 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" {
+ package vsatisfies $provided $required
+ } $satisfied
+ incr n
+}
+
+test package-vsatisfies-3.0 "package vsatisfies multiple" {
+ # yes no
+ package vsatisfies 8.4 8.4 7.3
+} 1
+
+test package-vsatisfies-3.1 "package vsatisfies multiple" {
+ # no yes
+ package vsatisfies 8.4 7.3 8.4
+} 1
+
+test package-vsatisfies-3.2 "package vsatisfies multiple" {
+ # yes yes
+ package vsatisfies 8.4.2 8.4 8.4.1
+} 1
+
+test package-vsatisfies-3.3 "package vsatisfies multiple" {
+ # 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} {
+ prefer
+} stable
+
+test package-prefer-1.1 {default} {
+ 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} {
+ catch {package prefer foo bar} msg
+ set msg
+} {wrong # args: should be "package prefer ?latest|stable?"}
+
+test package-prefer-2.1 {bogus argument} {
+ catch {package prefer foo} msg
+ set msg
+} {bad preference "foo": must be latest or stable}
+
+test package-prefer-3.0 {set, keep} {
+ package prefer stable
+} stable
+
+test package-prefer-3.1 {set stable, keep} {
+ prefer stable
+} {stable stable}
+
+test package-prefer-3.2 {set latest, change} {
+ prefer latest
+} {stable latest}
+
+test package-prefer-3.3 {set latest, keep} {
+ prefer latest latest
+} {stable latest latest}
+
+test package-prefer-3.3 {set stable, rejected} {
+ prefer latest stable
+} {stable latest latest}
+
+rename prefer {}
+
+
set auto_path $oldPath
package unknown $oldPkgUnknown
concat