diff options
Diffstat (limited to 'tests/pkg.test')
| -rw-r--r-- | tests/pkg.test | 1219 |
1 files changed, 1219 insertions, 0 deletions
diff --git a/tests/pkg.test b/tests/pkg.test new file mode 100644 index 0000000..b935a3f --- /dev/null +++ b/tests/pkg.test @@ -0,0 +1,1219 @@ +# -*- tcl -*- +# Commands covered: pkg +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 1995-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest 2.3.4 + namespace import -force ::tcltest::* +} + +# Do all this in a slave interp to avoid garbaging the +# package list +set i [interp create] +tcltest::loadIntoSlaveInterpreter $i {*}$argv + +interp eval $i { +namespace import -force ::tcltest::* +package forget {*}[package names] +set oldPkgUnknown [package unknown] +package unknown {} +set oldPath $auto_path +set auto_path "" + +test pkg-1.1 {Tcl_PkgProvide procedure} { + package forget t + package provide t 2.3 +} {} +test pkg-1.2 {Tcl_PkgProvide procedure} { + package forget t + package provide t 2.3 + list [catch {package provide t 2.2} msg] $msg +} {1 {conflicting versions provided for package "t": 2.3, then 2.2}} +test pkg-1.3 {Tcl_PkgProvide procedure} { + package forget t + package provide t 2.3 + list [catch {package provide t 2.4} msg] $msg +} {1 {conflicting versions provided for package "t": 2.3, then 2.4}} +test pkg-1.4 {Tcl_PkgProvide procedure} { + package forget t + package provide t 2.3 + list [catch {package provide t 3.3} msg] $msg +} {1 {conflicting versions provided for package "t": 2.3, then 3.3}} +test pkg-1.5 {Tcl_PkgProvide procedure} { + package forget t + package provide t 2.3 + 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} { + package ifneeded t $i "set x $i; package provide t $i" + } + set x xxx + package require t + set x +} {3.4} +test pkg-2.2 {Tcl_PkgRequire procedure, picking best version} { + package forget t + foreach i {1.4 3.4 2.3 2.4 2.2 3.5 3.2} { + package ifneeded t $i "set x $i; package provide t $i" + } + set x xxx + package require t + set x +} {3.5} +test pkg-2.3 {Tcl_PkgRequire procedure, picking best version} { + package forget t + foreach i {3.5 2.1 2.3} { + package ifneeded t $i "set x $i; package provide t $i" + } + set x xxx + package require t 2.2 + set x +} {2.3} +test pkg-2.4 {Tcl_PkgRequire procedure, picking best version} { + package forget t + foreach i {1.4 3.4 2.3 2.4 2.2} { + package ifneeded t $i "set x $i; package provide t $i" + } + set x xxx + package require -exact t 2.3 + set x +} {2.3} +test pkg-2.5 {Tcl_PkgRequire procedure, picking best version} { + package forget t + foreach i {1.4 3.4 2.3 2.4 2.2} { + package ifneeded t $i "set x $i; package provide t $i" + } + set x xxx + package require t 2.1 + set x +} {2.4} +test pkg-2.6 {Tcl_PkgRequire procedure, can't find suitable version} { + 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 t 2.5} msg] $msg +} {1 {can't find package t 2.5}} +test pkg-2.7 {Tcl_PkgRequire procedure, can't find suitable version} { + 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 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} { + 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 exactly 1.3}} +test pkg-2.9 {Tcl_PkgRequire procedure, can't find suitable version} { + package forget t + package unknown {} + list [catch {package require t} msg] $msg +} {1 {can't find package t}} +test pkg-2.10 {Tcl_PkgRequire procedure, error in ifneeded script} -body { + package forget t + package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"} + list [catch {package require t 2.1} msg] $msg $::errorInfo +} -match glob -result {1 {ifneeded test} {ifneeded test + while executing +"error "ifneeded test"" + ("package ifneeded*" script) + invoked from within +"package require t 2.1"}} +test pkg-2.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} -body { + package forget t + package ifneeded t 2.1 "set x invoked" + set x xxx + list [catch {package require t 2.1} msg] $msg $x +} -match glob -result {1 * invoked} +test pkg-2.12 {Tcl_PkgRequire procedure, self-deleting script} { + package forget t + package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2" + set x xxx + package require t 1.2 + set x +} {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 [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.5} +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" + } + package forget t + package unknown pkgUnknown + set x xxx + set result [list [package require t] $x] + package unknown {} + set result +} {1.2 loaded} +test pkg-2.15 {Tcl_PkgRequire procedure, "package unknown" support} { + 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} 0-} +test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} { + 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 0-" + ("package unknown" script) + invoked from within +"package require t"}} +test pkg-2.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} { + 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 exactly 1.5} {t 1.5-1.5}} +test pkg-2.18 {Tcl_PkgRequire procedure, version checks} { + package forget t + package provide t 2.3 + package require t +} {2.3} +test pkg-2.19 {Tcl_PkgRequire procedure, version checks} { + package forget t + package provide t 2.3 + package require t 2.1 +} {2.3} +test pkg-2.20 {Tcl_PkgRequire procedure, version checks} { + package forget t + package provide t 2.3 + package require t 2.3 +} {2.3} +test pkg-2.21 {Tcl_PkgRequire procedure, version checks} { + package forget t + package provide t 2.3 + list [catch {package require t 2.4} msg] $msg +} {1 {version conflict for package "t": have 2.3, need 2.4}} +test pkg-2.22 {Tcl_PkgRequire procedure, version checks} { + package forget t + package provide t 2.3 + list [catch {package require t 1.2} msg] $msg +} {1 {version conflict for package "t": have 2.3, need 1.2}} +test pkg-2.23 {Tcl_PkgRequire procedure, version checks} { + package forget t + package provide t 2.3 + package require -exact t 2.3 +} {2.3} +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 exactly 2.2}} +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} + list [catch {package require t 2.1} msg] $msg $::errorInfo +} -match glob -result {1 {ifneeded test} {EI + ("package ifneeded*" script) + invoked from within +"package require t 2.1"}} +test pkg-2.26 {Tcl_PkgRequire procedure, error in ifneeded script} -body { + package forget t + package ifneeded t 2.1 {package provide t 2.1; foreach x 1 {error "ifneeded test" EI}} + list [catch {package require t 2.1} msg] $msg $::errorInfo +} -match glob -result {1 {ifneeded test} {EI + ("foreach" body line 1) + invoked from within +"foreach x 1 {error "ifneeded test" EI}" + ("package ifneeded*" script) + invoked from within +"package require t 2.1"}} +test pkg-2.27 {Tcl_PkgRequire: circular dependency} -setup { + package forget foo +} -body { + package ifneeded foo 1 {package require foo 1} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob -result {circular package dependency:*} +test pkg-2.28 {Tcl_PkgRequire: circular dependency} -setup { + package forget foo +} -body { + package ifneeded foo 1 {package require foo 2} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob -result {circular package dependency:*} +test pkg-2.29 {Tcl_PkgRequire: circular dependency} -setup { + package forget foo + package forget bar +} -body { + package ifneeded foo 1 {package require bar 1; package provide foo 1} + package ifneeded bar 1 {package require foo 1; package provide bar 1} + package require foo 1 +} -cleanup { + package forget foo + package forget bar +} -returnCodes error -match glob -result {circular package dependency:*} +test pkg-2.30 {Tcl_PkgRequire: circular dependency} -setup { + package forget foo + package forget bar +} -body { + package ifneeded foo 1 {package require bar 1; package provide foo 1} + package ifneeded foo 2 {package provide foo 2} + package ifneeded bar 1 {package require foo 2; package provide bar 1} + package require foo 1 +} -cleanup { + package forget foo + package forget bar +} -returnCodes error -match glob -result {circular package dependency:*} +test pkg-2.31 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1 {package provide foo 1; error foo} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob -result foo +test pkg-2.32 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1 {package provide foo 1; error foo} + catch {package require foo 1} + package provide foo +} -cleanup { + package forget foo +} -result {} +test pkg-2.33 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1 {package provide foo 2} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob -result {attempt to provide package * failed:*} +test pkg-2.34 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1 {package provide foo 1.1} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob -result {attempt to provide package * failed:*} +test pkg-2.34.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1.1 {package provide foo 1} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob -result {attempt to provide package * failed:*} +test pkg-2.34.2 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1.1 {package provide foo 1} + package require foo 1.1 +} -cleanup { + package forget foo +} -returnCodes error -match glob -result {attempt to provide package * failed:*} +test pkg-2.35 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1 {} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob -result {attempt to provide package * failed:*} +test pkg-2.35.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1 {break} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob \ +-result {attempt to provide package * failed: bad return code:*} +test pkg-2.36 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1 {continue} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob \ +-result {attempt to provide package * failed: bad return code:*} +test pkg-2.37 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1 {return} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob \ +-result {attempt to provide package * failed: bad return code:*} +test pkg-2.38 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1 {return -level 0 -code 10} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob \ +-result {attempt to provide package * failed: bad return code:*} +test pkg-2.39 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo + set saveUnknown [package unknown] + package unknown {package provide foo 2 ;#} +} -body { + package require foo 1 +} -cleanup { + package forget foo + package unknown $saveUnknown +} -returnCodes error -match glob -result * +test pkg-2.40 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo + set saveUnknown [package unknown] + package unknown {break ;#} +} -body { + package require foo 1 +} -cleanup { + package forget foo + package unknown $saveUnknown +} -returnCodes error -match glob -result {bad return code:*} +test pkg-2.41 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo + set saveUnknown [package unknown] + package unknown {continue ;#} +} -body { + package require foo 1 +} -cleanup { + package forget foo + package unknown $saveUnknown +} -returnCodes error -match glob -result {bad return code:*} +test pkg-2.42 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo + set saveUnknown [package unknown] + package unknown {return ;#} +} -body { + package require foo 1 +} -cleanup { + package forget foo + package unknown $saveUnknown +} -returnCodes error -match glob -result {bad return code:*} +test pkg-2.43 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo + set saveUnknown [package unknown] + package unknown {return -level 0 -code 10 ;#} +} -body { + package require foo 1 +} -cleanup { + package forget foo + package unknown $saveUnknown +} -returnCodes error -match glob -result {bad return code:*} +test pkg-2.44 {Tcl_PkgRequire: exact version matching (1578344)} -setup { + package provide demo 1.2.3 +} -body { + package require -exact demo 1.2 +} -cleanup { + package forget demo +} -returnCodes error -result {version conflict for package "demo": have 1.2.3, need exactly 1.2} + + +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 ...?"}} +test pkg-3.2 {Tcl_PackageCmd procedure, "forget" option} { + foreach i [package names] { + package forget $i + } + package names +} {} +test pkg-3.3 {Tcl_PackageCmd procedure, "forget" option} { + foreach i [package names] { + package forget $i + } + package forget foo +} {} +test pkg-3.4 {Tcl_PackageCmd procedure, "forget" option} { + foreach i [package names] { + package forget $i + } + package ifneeded t 1.1 {first script} + package ifneeded t 2.3 {second script} + package ifneeded x 1.4 {x's script} + set result {} + lappend result [lsort [package names]] [package versions t] + package forget t + lappend result [lsort [package names]] [package versions t] +} {{t x} {1.1 2.3} x {}} +test pkg-3.5 {Tcl_PackageCmd procedure, "forget" option} { + foreach i [package names] { + package forget $i + } + package ifneeded a 1.1 {first script} + package ifneeded b 2.3 {second script} + package ifneeded c 1.4 {third script} + package forget + set result [list [lsort [package names]]] + package forget a c + lappend result [lsort [package names]] +} {{a b c} b} +test pkg-3.5.1 {Tcl_PackageCmd procedure, "forget" option} { + # Test for Bug 415273 + package ifneeded a 1 "I should have been forgotten" + package forget no-such-package a + set x [package ifneeded a 1] + package forget a + set x +} {} +test pkg-3.6 {Tcl_PackageCmd procedure, "ifneeded" option} { + list [catch {package ifneeded a} msg] $msg +} {1 {wrong # args: should be "package ifneeded package version ?script?"}} +test pkg-3.7 {Tcl_PackageCmd procedure, "ifneeded" option} { + list [catch {package ifneeded a b c d} msg] $msg +} {1 {wrong # args: should be "package ifneeded package version ?script?"}} +test pkg-3.8 {Tcl_PackageCmd procedure, "ifneeded" option} { + list [catch {package ifneeded t xyz} msg] $msg +} {1 {expected version number but got "xyz"}} +test pkg-3.9 {Tcl_PackageCmd procedure, "ifneeded" option} { + foreach i [package names] { + package forget $i + } + list [package ifneeded foo 1.1] [package names] +} {{} {}} +test pkg-3.10 {Tcl_PackageCmd procedure, "ifneeded" option} { + package forget t + package ifneeded t 1.4 "script for t 1.4" + list [package names] [package ifneeded t 1.4] [package versions t] +} {t {script for t 1.4} 1.4} +test pkg-3.11 {Tcl_PackageCmd procedure, "ifneeded" option} { + package forget t + package ifneeded t 1.4 "script for t 1.4" + list [package ifneeded t 1.5] [package names] [package versions t] +} {{} t 1.4} +test pkg-3.12 {Tcl_PackageCmd procedure, "ifneeded" option} { + package forget t + package ifneeded t 1.4 "script for t 1.4" + package ifneeded t 1.4 "second script for t 1.4" + list [package ifneeded t 1.4] [package names] [package versions t] +} {{second script for t 1.4} t 1.4} +test pkg-3.13 {Tcl_PackageCmd procedure, "ifneeded" option} { + package forget t + package ifneeded t 1.4 "script for t 1.4" + package ifneeded t 1.2 "second script" + package ifneeded t 3.1 "last script" + list [package ifneeded t 1.2] [package versions t] +} {{second script} {1.4 1.2 3.1}} +test pkg-3.14 {Tcl_PackageCmd procedure, "names" option} { + list [catch {package names a} msg] $msg +} {1 {wrong # args: should be "package names"}} +test pkg-3.15 {Tcl_PackageCmd procedure, "names" option} { + foreach i [package names] { + package forget $i + } + package names +} {} +test pkg-3.16 {Tcl_PackageCmd procedure, "names" option} { + foreach i [package names] { + package forget $i + } + package ifneeded x 1.2 {dummy} + package provide x 1.3 + package provide y 2.4 + catch {package require z 47.16} + lsort [package names] +} {x y} +test pkg-3.17 {Tcl_PackageCmd procedure, "provide" option} { + list [catch {package provide} msg] $msg +} {1 {wrong # args: should be "package provide package ?version?"}} +test pkg-3.18 {Tcl_PackageCmd procedure, "provide" option} { + list [catch {package provide a b c} msg] $msg +} {1 {wrong # args: should be "package provide package ?version?"}} +test pkg-3.19 {Tcl_PackageCmd procedure, "provide" option} { + package forget t + package provide t +} {} +test pkg-3.20 {Tcl_PackageCmd procedure, "provide" option} { + package forget t + package provide t 2.3 + package provide t +} {2.3} +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} { + list [catch {package require} msg] $msg +} {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 + # 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"}} +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} { + 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} { + 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 + package require t 2.1 +} {2.3} +test pkg-3.31 {Tcl_PackageCmd procedure, "require" option} { + package forget t + list [catch {package require t} msg] $msg +} {1 {can't find package t}} +test pkg-3.32 {Tcl_PackageCmd procedure, "require" option} { + package forget t + package ifneeded t 2.3 "error {synthetic error}" + list [catch {package require t 2.3} msg] $msg +} {1 {synthetic error}} +test pkg-3.33 {Tcl_PackageCmd procedure, "unknown" option} { + list [catch {package unknown a b} msg] $msg +} {1 {wrong # args: should be "package unknown ?command?"}} +test pkg-3.34 {Tcl_PackageCmd procedure, "unknown" option} { + package unknown "test script" + package unknown +} {test script} +test pkg-3.35 {Tcl_PackageCmd procedure, "unknown" option} { + package unknown "test script" + package unknown {} + package unknown +} {} +test pkg-3.36 {Tcl_PackageCmd procedure, "vcompare" option} { + list [catch {package vcompare a} msg] $msg +} {1 {wrong # args: should be "package vcompare version1 version2"}} +test pkg-3.37 {Tcl_PackageCmd procedure, "vcompare" option} { + list [catch {package vcompare a b c} msg] $msg +} {1 {wrong # args: should be "package vcompare version1 version2"}} +test pkg-3.38 {Tcl_PackageCmd procedure, "vcompare" option} { + list [catch {package vcompare x.y 3.4} msg] $msg +} {1 {expected version number but got "x.y"}} +test pkg-3.39 {Tcl_PackageCmd procedure, "vcompare" option} { + list [catch {package vcompare 2.1 a.b} msg] $msg +} {1 {expected version number but got "a.b"}} +test pkg-3.40 {Tcl_PackageCmd procedure, "vcompare" option} { + package vc 2.1 2.3 +} {-1} +test pkg-3.41 {Tcl_PackageCmd procedure, "vcompare" option} { + package vc 2.2.4 2.2.4 +} {0} +test pkg-3.42 {Tcl_PackageCmd procedure, "versions" option} { + list [catch {package versions} msg] $msg +} {1 {wrong # args: should be "package versions package"}} +test pkg-3.43 {Tcl_PackageCmd procedure, "versions" option} { + list [catch {package versions a b} msg] $msg +} {1 {wrong # args: should be "package versions package"}} +test pkg-3.44 {Tcl_PackageCmd procedure, "versions" option} { + package forget t + package versions t +} {} +test pkg-3.45 {Tcl_PackageCmd procedure, "versions" option} { + package forget t + package provide t 2.3 + package versions t +} {} +test pkg-3.46 {Tcl_PackageCmd procedure, "versions" option} { + package forget t + package ifneeded t 2.3 x + package ifneeded t 2.4 y + package versions t +} {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 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"}} +test pkg-3.50 {Tcl_PackageCmd procedure, "vsatisfies" option} { + list [catch {package vcompare 2.1 a.b} msg] $msg +} {1 {expected version number but got "a.b"}} +test pkg-3.51 {Tcl_PackageCmd procedure, "vsatisfies" option} { + package vs 2.3 2.1 +} {1} +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} { + 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} { + 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. + +test pkg-4.1 {TclFreePackageInfo procedure} { + interp create foo + foo eval { + package ifneeded t 2.3 x + package ifneeded t 2.4 y + package ifneeded x 3.1 z + package provide q 4.3 + package unknown "will this get freed?" + } + interp delete foo +} {} +test pkg-4.2 {TclFreePackageInfo procedure} -body { + interp create foo + foo eval { + package ifneeded t 2.3 x + package ifneeded t 2.4 y + package ifneeded x 3.1 z + package provide q 4.3 + } + foo alias z kill + proc kill {} { + interp delete foo + } + foo eval package require x 3.1 +} -returnCodes error -match glob -result * + +test pkg-5.1 {CheckVersion procedure} { + list [catch {package vcompare 1 2.1} msg] $msg +} {0 -1} +test pkg-5.2 {CheckVersion procedure} { + list [catch {package vcompare .1 2.1} msg] $msg +} {1 {expected version number but got ".1"}} +test pkg-5.3 {CheckVersion procedure} { + list [catch {package vcompare 111.2a.3 2.1} msg] $msg +} {1 {expected version number but got "111.2a.3"}} +test pkg-5.4 {CheckVersion procedure} { + list [catch {package vcompare 1.2.3. 2.1} msg] $msg +} {1 {expected version number but got "1.2.3."}} +test pkg-5.5 {CheckVersion procedure} { + list [catch {package vcompare 1.2..3 2.1} msg] $msg +} {1 {expected version number but got "1.2..3"}} + +test pkg-6.1 {ComparePkgVersions procedure} { + package vcompare 1.23 1.22 +} {1} +test pkg-6.2 {ComparePkgVersions procedure} { + package vcompare 1.22.1.2.3 1.22.1.2.3 +} {0} +test pkg-6.3 {ComparePkgVersions procedure} { + package vcompare 1.21 1.22 +} {-1} +test pkg-6.4 {ComparePkgVersions procedure} { + package vcompare 1.21 1.21.2 +} {-1} +test pkg-6.5 {ComparePkgVersions procedure} { + package vcompare 1.21.1 1.21 +} {1} +test pkg-6.6 {ComparePkgVersions procedure} { + package vsatisfies 1.21.1 1.21 +} {1} +test pkg-6.7 {ComparePkgVersions procedure} { + package vsatisfies 2.22.3 1.21 +} {0} +test pkg-6.8 {ComparePkgVersions procedure} { + package vsatisfies 1 1 +} {1} +test pkg-6.9 {ComparePkgVersions procedure} { + package vsatisfies 2 1 +} {0} + +test pkg-7.1 {Tcl_PkgPresent procedure, any version} { + package forget t + package provide t 2.4 + package present t +} {2.4} +test pkg-7.2 {Tcl_PkgPresent procedure, correct version} { + package forget t + package provide t 2.4 + package present t 2.4 +} {2.4} +test pkg-7.3 {Tcl_PkgPresent procedure, satisfying version} { + package forget t + package provide t 2.4 + package present t 2.0 +} {2.4} +test pkg-7.4 {Tcl_PkgPresent procedure, not satisfying version} { + package forget t + package provide t 2.4 + list [catch {package present t 2.6} msg] $msg +} {1 {version conflict for package "t": have 2.4, need 2.6}} +test pkg-7.5 {Tcl_PkgPresent procedure, not satisfying version} { + package forget t + package provide t 2.4 + list [catch {package present t 1.0} msg] $msg +} {1 {version conflict for package "t": have 2.4, need 1.0}} +test pkg-7.6 {Tcl_PkgPresent procedure, exact version} { + package forget t + package provide t 2.4 + package present -exact t 2.4 +} {2.4} +test pkg-7.7 {Tcl_PkgPresent procedure, not exact version} { + package forget t + package provide t 2.4 + list [catch {package present -exact t 2.3} msg] $msg +} {1 {version conflict for package "t": have 2.4, need exactly 2.3}} +test pkg-7.8 {Tcl_PkgPresent procedure, unknown package} { + package forget t + list [catch {package present t} msg] $msg +} {1 {package t is not present}} +test pkg-7.9 {Tcl_PkgPresent procedure, unknown package} { + package forget t + list [catch {package present t 2.4} msg] $msg +} {1 {package t 2.4 is not present}} +test pkg-7.10 {Tcl_PkgPresent procedure, unknown package} { + package forget t + list [catch {package present -exact t 2.4} msg] $msg +} {1 {package t 2.4 is not present}} +test pkg-7.11 {Tcl_PackageCmd procedure, "present" option} { + list [catch {package present} msg] $msg +} {1 {wrong # args: should be "package present ?-exact? package ?requirement...?"}} +test pkg-7.12 {Tcl_PackageCmd procedure, "present" option} { + list [catch {package present a b c} msg] $msg +} {1 {expected version number but got "b"}} +test pkg-7.13 {Tcl_PackageCmd procedure, "present" option} { + list [catch {package present -exact a b c} msg] $msg +} {1 {wrong # args: should be "package present ?-exact? package ?requirement...?"}} +test pkg-7.14 {Tcl_PackageCmd procedure, "present" option} { + list [catch {package present -bs a b} msg] $msg +} {1 {expected version number but got "a"}} +test pkg-7.15 {Tcl_PackageCmd procedure, "present" option} { + list [catch {package present x a.b} msg] $msg +} {1 {expected version number but got "a.b"}} +test pkg-7.16 {Tcl_PackageCmd procedure, "present" option} { + list [catch {package present -exact x a.b} msg] $msg +} {1 {expected version number but got "a.b"}} +test pkg-7.17 {Tcl_PackageCmd procedure, "present" option} { + list [catch {package present -exact x} msg] $msg +} {1 {wrong # args: should be "package present ?-exact? package ?requirement...?"}} +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 ?requirement...?"}} + + + + +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 + 10 8 0 1 + 8 10 0 -1 + 0.0.1.2 0.1.2 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 +} + +test package-vcompare-2.0 {package vcompare at 32bit boundary} { + package vcompare [expr {1<<31}] [expr {(1<<31)-1}] +} 1 + +# Note: It is correct that the result of the very first test, +# i.e. "5.0 5.0a0" is 1, i.e. that version 5.0a0 satisfies a 5.0 +# requirement. + +# The requirement "5.0" internally translates first to "5.0-6", and +# then to its final form of "5.0a0-6a0". These translations are +# explicitly specified by the TIP (Search for "padded/extended +# internally with 'a0'"). This was done intentionally for exactly the +# tested case, that an alpha package can satisfy a requirement for the +# regular package. An example would be a package FOO requiring Tcl 8.X +# for its operation. It can be used with Tcl 8.Xa0. Without our +# translation that would not be possible. + +set n 0 +foreach {required provided satisfied} { + 5.0 5.0a0 1 + 5.0a0 5.0 1 + + 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.4 {set stable, rejected} { + prefer latest stable +} {stable latest latest} + +rename prefer {} + + +set auto_path $oldPath +package unknown $oldPkgUnknown +concat + +cleanupTests +} + +# cleanup +interp delete $i +::tcltest::cleanupTests +return |