# -*- 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. # # RCS: @(#) $Id: pkg.test,v 1.26.2.1 2007/09/11 17:58:25 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } # Do all this in a slave interp to avoid garbaging the # package list set i [interp create] interp eval $i [list set argv $argv] interp eval $i [list package require tcltest 2] interp eval $i [list namespace import -force ::tcltest::*] interp eval $i { 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