os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/pkg.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/pkg.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,1314 @@
1.4 +# Commands covered: pkg
1.5 +#
1.6 +# This file contains a collection of tests for one or more of the Tcl
1.7 +# built-in commands. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1995-1996 Sun Microsystems, Inc.
1.11 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.12 +#
1.13 +# See the file "license.terms" for information on usage and redistribution
1.14 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.15 +#
1.16 +# RCS: @(#) $Id: pkg.test,v 1.9.12.10 2007/02/22 20:25:29 andreas_kupries Exp $
1.17 +
1.18 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.19 + package require tcltest 2
1.20 + namespace import -force ::tcltest::*
1.21 +}
1.22 +
1.23 +# Do all this in a slave interp to avoid garbaging the
1.24 +# package list
1.25 +set i [interp create]
1.26 +interp eval $i [list set argv $argv]
1.27 +interp eval $i [list package require tcltest 2]
1.28 +interp eval $i [list namespace import -force ::tcltest::*]
1.29 +interp eval $i {
1.30 +
1.31 +eval package forget [package names]
1.32 +set oldPkgUnknown [package unknown]
1.33 +package unknown {}
1.34 +set oldPath $auto_path
1.35 +set auto_path ""
1.36 +
1.37 +testConstraint tip268 [info exists tcl_platform(tip,268)]
1.38 +testConstraint !tip268 [expr {![info exists tcl_platform(tip,268)]}]
1.39 +
1.40 +test pkg-1.1 {Tcl_PkgProvide procedure} {
1.41 + package forget t
1.42 + package provide t 2.3
1.43 +} {}
1.44 +test pkg-1.2 {Tcl_PkgProvide procedure} {
1.45 + package forget t
1.46 + package provide t 2.3
1.47 + list [catch {package provide t 2.2} msg] $msg
1.48 +} {1 {conflicting versions provided for package "t": 2.3, then 2.2}}
1.49 +test pkg-1.3 {Tcl_PkgProvide procedure} {
1.50 + package forget t
1.51 + package provide t 2.3
1.52 + list [catch {package provide t 2.4} msg] $msg
1.53 +} {1 {conflicting versions provided for package "t": 2.3, then 2.4}}
1.54 +test pkg-1.4 {Tcl_PkgProvide procedure} {
1.55 + package forget t
1.56 + package provide t 2.3
1.57 + list [catch {package provide t 3.3} msg] $msg
1.58 +} {1 {conflicting versions provided for package "t": 2.3, then 3.3}}
1.59 +test pkg-1.5 {Tcl_PkgProvide procedure} {
1.60 + package forget t
1.61 + package provide t 2.3
1.62 + package provide t 2.3
1.63 +} {}
1.64 +
1.65 +test pkg-1.6 {Tcl_PkgProvide procedure} tip268 {
1.66 + package forget t
1.67 + package provide t 2.3a1
1.68 +} {}
1.69 +
1.70 +set n 0
1.71 +foreach v {
1.72 + 2.3k1 2a3a2 2ab3 2.a4 2.b4 2b.4 2a.4 2ba4 2a4b1
1.73 + 2b4a1 2b3b2
1.74 +} {
1.75 + test pkg-1.7.$n {Tcl_PkgProvide procedure} tip268 {
1.76 + package forget t
1.77 + list [catch {package provide t $v} msg] $msg
1.78 + } [list 1 "expected version number but got \"$v\""]
1.79 + incr n
1.80 +}
1.81 +
1.82 +test pkg-2.1 {Tcl_PkgRequire procedure, picking best version} {
1.83 + package forget t
1.84 + foreach i {1.4 3.4 2.3 2.4 2.2} {
1.85 + package ifneeded t $i "set x $i; package provide t $i"
1.86 + }
1.87 + set x xxx
1.88 + package require t
1.89 + set x
1.90 +} {3.4}
1.91 +test pkg-2.2 {Tcl_PkgRequire procedure, picking best version} {
1.92 + package forget t
1.93 + foreach i {1.4 3.4 2.3 2.4 2.2 3.5 3.2} {
1.94 + package ifneeded t $i "set x $i; package provide t $i"
1.95 + }
1.96 + set x xxx
1.97 + package require t
1.98 + set x
1.99 +} {3.5}
1.100 +test pkg-2.3 {Tcl_PkgRequire procedure, picking best version} {
1.101 + package forget t
1.102 + foreach i {3.5 2.1 2.3} {
1.103 + package ifneeded t $i "set x $i; package provide t $i"
1.104 + }
1.105 + set x xxx
1.106 + package require t 2.2
1.107 + set x
1.108 +} {2.3}
1.109 +test pkg-2.4 {Tcl_PkgRequire procedure, picking best version} {
1.110 + package forget t
1.111 + foreach i {1.4 3.4 2.3 2.4 2.2} {
1.112 + package ifneeded t $i "set x $i; package provide t $i"
1.113 + }
1.114 + set x xxx
1.115 + package require -exact t 2.3
1.116 + set x
1.117 +} {2.3}
1.118 +test pkg-2.5 {Tcl_PkgRequire procedure, picking best version} {
1.119 + package forget t
1.120 + foreach i {1.4 3.4 2.3 2.4 2.2} {
1.121 + package ifneeded t $i "set x $i; package provide t $i"
1.122 + }
1.123 + set x xxx
1.124 + package require t 2.1
1.125 + set x
1.126 +} {2.4}
1.127 +test pkg-2.6 {Tcl_PkgRequire procedure, can't find suitable version} {
1.128 + package forget t
1.129 + package unknown {}
1.130 + foreach i {1.4 3.4 2.3 2.4 2.2} {
1.131 + package ifneeded t $i "set x $i"
1.132 + }
1.133 + list [catch {package require t 2.5} msg] $msg
1.134 +} {1 {can't find package t 2.5}}
1.135 +test pkg-2.7 {Tcl_PkgRequire procedure, can't find suitable version} {
1.136 + package forget t
1.137 + package unknown {}
1.138 + foreach i {1.4 3.4 2.3 2.4 2.2} {
1.139 + package ifneeded t $i "set x $i"
1.140 + }
1.141 + list [catch {package require t 4.1} msg] $msg
1.142 +} {1 {can't find package t 4.1}}
1.143 +test pkg-2.8 {Tcl_PkgRequire procedure, can't find suitable version} !tip268 {
1.144 + package forget t
1.145 + package unknown {}
1.146 + foreach i {1.4 3.4 2.3 2.4 2.2} {
1.147 + package ifneeded t $i "set x $i"
1.148 + }
1.149 + list [catch {package require -exact t 1.3} msg] $msg
1.150 +
1.151 +} {1 {can't find package t 1.3}}
1.152 +test pkg-2.8-268 {Tcl_PkgRequire procedure, can't find suitable version} tip268 {
1.153 + package forget t
1.154 + package unknown {}
1.155 + foreach i {1.4 3.4 2.3 2.4 2.2} {
1.156 + package ifneeded t $i "set x $i"
1.157 + }
1.158 + list [catch {package require -exact t 1.3} msg] $msg
1.159 +
1.160 +} {1 {can't find package t 1.3-1.4}}
1.161 +test pkg-2.9 {Tcl_PkgRequire procedure, can't find suitable version} {
1.162 + package forget t
1.163 + package unknown {}
1.164 + list [catch {package require t} msg] $msg
1.165 +} {1 {can't find package t}}
1.166 +test pkg-2.10 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
1.167 + package forget t
1.168 + package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"}
1.169 + list [catch {package require t 2.1} msg] $msg $errorInfo
1.170 +} -match glob -result {1 {ifneeded test} {ifneeded test
1.171 + while executing
1.172 +"error "ifneeded test""
1.173 + ("package ifneeded*" script)
1.174 + invoked from within
1.175 +"package require t 2.1"}}
1.176 +test pkg-2.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} -body {
1.177 + package forget t
1.178 + package ifneeded t 2.1 "set x invoked"
1.179 + set x xxx
1.180 + list [catch {package require t 2.1} msg] $msg $x
1.181 +} -match glob -result {1 * invoked}
1.182 +test pkg-2.12 {Tcl_PkgRequire procedure, self-deleting script} {
1.183 + package forget t
1.184 + package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2"
1.185 + set x xxx
1.186 + package require t 1.2
1.187 + set x
1.188 +} {1.2}
1.189 +test pkg-2.13-!268 {Tcl_PkgRequire procedure, "package unknown" support} !tip268 {
1.190 + proc pkgUnknown args {
1.191 + global x
1.192 + set x $args
1.193 + package provide [lindex $args 0] [lindex $args 1]
1.194 + }
1.195 + package forget t
1.196 + foreach i {1.4 3.4 2.3 2.4 2.2} {
1.197 + package ifneeded t $i "set x $i"
1.198 + }
1.199 + package unknown pkgUnknown
1.200 + set x xxx
1.201 + package require -exact t 1.5
1.202 + package unknown {}
1.203 + set x
1.204 +} {t 1.5 -exact}
1.205 +
1.206 +test pkg-2.13-268 {Tcl_PkgRequire procedure, "package unknown" support} tip268 {
1.207 + proc pkgUnknown args {
1.208 + # args = name requirement
1.209 + # requirement = v-v (for exact version)
1.210 + global x
1.211 + set x $args
1.212 + package provide [lindex $args 0] [lindex [split [lindex $args 1] -] 0]
1.213 + }
1.214 + package forget t
1.215 + foreach i {1.4 3.4 2.3 2.4 2.2} {
1.216 + package ifneeded t $i "set x $i"
1.217 + }
1.218 + package unknown pkgUnknown
1.219 + set x xxx
1.220 + package require -exact t 1.5
1.221 + package unknown {}
1.222 + set x
1.223 +} {t 1.5-1.6}
1.224 +
1.225 +test pkg-2.14 {Tcl_PkgRequire procedure, "package unknown" support} {
1.226 + proc pkgUnknown args {
1.227 + package ifneeded t 1.2 "set x loaded; package provide t 1.2"
1.228 + }
1.229 + package forget t
1.230 + package unknown pkgUnknown
1.231 + set x xxx
1.232 + set result [list [package require t] $x]
1.233 + package unknown {}
1.234 + set result
1.235 +} {1.2 loaded}
1.236 +test pkg-2.15 {Tcl_PkgRequire procedure, "package unknown" support} !tip268 {
1.237 + proc pkgUnknown args {
1.238 + global x
1.239 + set x $args
1.240 + package provide [lindex $args 0] 2.0
1.241 + }
1.242 + package forget {a b}
1.243 + package unknown pkgUnknown
1.244 + set x xxx
1.245 + package require {a b}
1.246 + package unknown {}
1.247 + set x
1.248 +} {{a b} {}}
1.249 +test pkg-2.15-268 {Tcl_PkgRequire procedure, "package unknown" support} tip268 {
1.250 + proc pkgUnknown args {
1.251 + global x
1.252 + set x $args
1.253 + package provide [lindex $args 0] 2.0
1.254 + }
1.255 + package forget {a b}
1.256 + package unknown pkgUnknown
1.257 + set x xxx
1.258 + package require {a b}
1.259 + package unknown {}
1.260 + set x
1.261 +} {{a b} 0-}
1.262 +test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} !tip268 {
1.263 + proc pkgUnknown args {
1.264 + error "testing package unknown"
1.265 + }
1.266 + package forget t
1.267 + package unknown pkgUnknown
1.268 + set result [list [catch {package require t} msg] $msg $errorInfo]
1.269 + package unknown {}
1.270 + set result
1.271 +} {1 {testing package unknown} {testing package unknown
1.272 + while executing
1.273 +"error "testing package unknown""
1.274 + (procedure "pkgUnknown" line 2)
1.275 + invoked from within
1.276 +"pkgUnknown t {}"
1.277 + ("package unknown" script)
1.278 + invoked from within
1.279 +"package require t"}}
1.280 +test pkg-2.16-268 {Tcl_PkgRequire procedure, "package unknown" error} tip268 {
1.281 + proc pkgUnknown args {
1.282 + error "testing package unknown"
1.283 + }
1.284 + package forget t
1.285 + package unknown pkgUnknown
1.286 + set result [list [catch {package require t} msg] $msg $errorInfo]
1.287 + package unknown {}
1.288 + set result
1.289 +} {1 {testing package unknown} {testing package unknown
1.290 + while executing
1.291 +"error "testing package unknown""
1.292 + (procedure "pkgUnknown" line 2)
1.293 + invoked from within
1.294 +"pkgUnknown t 0-"
1.295 + ("package unknown" script)
1.296 + invoked from within
1.297 +"package require t"}}
1.298 +test pkg-2.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} !tip268 {
1.299 + proc pkgUnknown args {
1.300 + global x
1.301 + set x $args
1.302 + }
1.303 + package forget t
1.304 + foreach i {1.4 3.4 2.3 2.4 2.2} {
1.305 + package ifneeded t $i "set x $i"
1.306 + }
1.307 + package unknown pkgUnknown
1.308 + set x xxx
1.309 + set result [list [catch {package require -exact t 1.5} msg] $msg $x]
1.310 + package unknown {}
1.311 + set result
1.312 +} {1 {can't find package t 1.5} {t 1.5 -exact}}
1.313 +test pkg-2.17-268 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} tip268 {
1.314 + proc pkgUnknown args {
1.315 + global x
1.316 + set x $args
1.317 + }
1.318 + package forget t
1.319 + foreach i {1.4 3.4 2.3 2.4 2.2} {
1.320 + package ifneeded t $i "set x $i"
1.321 + }
1.322 + package unknown pkgUnknown
1.323 + set x xxx
1.324 + set result [list [catch {package require -exact t 1.5} msg] $msg $x]
1.325 + package unknown {}
1.326 + set result
1.327 +} {1 {can't find package t 1.5-1.6} {t 1.5-1.6}}
1.328 +test pkg-2.18 {Tcl_PkgRequire procedure, version checks} {
1.329 + package forget t
1.330 + package provide t 2.3
1.331 + package require t
1.332 +} {2.3}
1.333 +test pkg-2.19 {Tcl_PkgRequire procedure, version checks} {
1.334 + package forget t
1.335 + package provide t 2.3
1.336 + package require t 2.1
1.337 +} {2.3}
1.338 +test pkg-2.20 {Tcl_PkgRequire procedure, version checks} {
1.339 + package forget t
1.340 + package provide t 2.3
1.341 + package require t 2.3
1.342 +} {2.3}
1.343 +test pkg-2.21 {Tcl_PkgRequire procedure, version checks} {
1.344 + package forget t
1.345 + package provide t 2.3
1.346 + list [catch {package require t 2.4} msg] $msg
1.347 +} {1 {version conflict for package "t": have 2.3, need 2.4}}
1.348 +test pkg-2.22 {Tcl_PkgRequire procedure, version checks} {
1.349 + package forget t
1.350 + package provide t 2.3
1.351 + list [catch {package require t 1.2} msg] $msg
1.352 +} {1 {version conflict for package "t": have 2.3, need 1.2}}
1.353 +test pkg-2.23 {Tcl_PkgRequire procedure, version checks} {
1.354 + package forget t
1.355 + package provide t 2.3
1.356 + package require -exact t 2.3
1.357 +} {2.3}
1.358 +test pkg-2.24 {Tcl_PkgRequire procedure, version checks} !tip268 {
1.359 + package forget t
1.360 + package provide t 2.3
1.361 + list [catch {package require -exact t 2.2} msg] $msg
1.362 +} {1 {version conflict for package "t": have 2.3, need 2.2}}
1.363 +test pkg-2.24-268 {Tcl_PkgRequire procedure, version checks} tip268 {
1.364 + package forget t
1.365 + package provide t 2.3
1.366 + list [catch {package require -exact t 2.2} msg] $msg
1.367 +} {1 {version conflict for package "t": have 2.3, need 2.2-2.3}}
1.368 +test pkg-2.25 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
1.369 + package forget t
1.370 + package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test" EI}
1.371 + list [catch {package require t 2.1} msg] $msg $errorInfo
1.372 +} -match glob -result {1 {ifneeded test} {EI
1.373 + ("package ifneeded*" script)
1.374 + invoked from within
1.375 +"package require t 2.1"}} -constraints knownBug
1.376 +test pkg-2.26 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
1.377 + package forget t
1.378 + package ifneeded t 2.1 {package provide t 2.1; foreach x 1 {error "ifneeded test" EI}}
1.379 + list [catch {package require t 2.1} msg] $msg $errorInfo
1.380 +} -match glob -result {1 {ifneeded test} {EI
1.381 + ("foreach" body line 1)
1.382 + invoked from within
1.383 +"foreach x 1 {error "ifneeded test" EI}"
1.384 + ("package ifneeded*" script)
1.385 + invoked from within
1.386 +"package require t 2.1"}}
1.387 +test pkg-2.27 {Tcl_PkgRequire: circular dependency} -setup {
1.388 + package forget foo
1.389 +} -body {
1.390 + package ifneeded foo 1 {package require foo 1}
1.391 + package require foo 1
1.392 +} -cleanup {
1.393 + package forget foo
1.394 +} -returnCodes error -match glob -result {circular package dependency:*}
1.395 +test pkg-2.28 {Tcl_PkgRequire: circular dependency} -setup {
1.396 + package forget foo
1.397 +} -body {
1.398 + package ifneeded foo 1 {package require foo 2}
1.399 + package require foo 1
1.400 +} -cleanup {
1.401 + package forget foo
1.402 +} -returnCodes error -match glob -result {circular package dependency:*}
1.403 +test pkg-2.29 {Tcl_PkgRequire: circular dependency} -setup {
1.404 + package forget foo
1.405 + package forget bar
1.406 +} -body {
1.407 + package ifneeded foo 1 {package require bar 1; package provide foo 1}
1.408 + package ifneeded bar 1 {package require foo 1; package provide bar 1}
1.409 + package require foo 1
1.410 +} -cleanup {
1.411 + package forget foo
1.412 + package forget bar
1.413 +} -returnCodes error -match glob -result {circular package dependency:*}
1.414 +test pkg-2.30 {Tcl_PkgRequire: circular dependency} -setup {
1.415 + package forget foo
1.416 + package forget bar
1.417 +} -body {
1.418 + package ifneeded foo 1 {package require bar 1; package provide foo 1}
1.419 + package ifneeded foo 2 {package provide foo 2}
1.420 + package ifneeded bar 1 {package require foo 2; package provide bar 1}
1.421 + package require foo 1
1.422 +} -cleanup {
1.423 + package forget foo
1.424 + package forget bar
1.425 +} -returnCodes error -match glob -result {circular package dependency:*}
1.426 +test pkg-2.31 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
1.427 + package forget foo
1.428 +} -body {
1.429 + package ifneeded foo 1 {package provide foo 1; error foo}
1.430 + package require foo 1
1.431 +} -cleanup {
1.432 + package forget foo
1.433 +} -returnCodes error -match glob -result foo
1.434 +test pkg-2.32 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
1.435 + package forget foo
1.436 +} -body {
1.437 + package ifneeded foo 1 {package provide foo 1; error foo}
1.438 + catch {package require foo 1}
1.439 + package provide foo
1.440 +} -cleanup {
1.441 + package forget foo
1.442 +} -result {}
1.443 +test pkg-2.33 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
1.444 + package forget foo
1.445 +} -body {
1.446 + package ifneeded foo 1 {package provide foo 2}
1.447 + package require foo 1
1.448 +} -cleanup {
1.449 + package forget foo
1.450 +} -returnCodes error -match glob -result {attempt to provide package * failed:*}
1.451 +test pkg-2.34 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
1.452 + package forget foo
1.453 +} -body {
1.454 + package ifneeded foo 1 {package provide foo 1.1}
1.455 + package require foo 1
1.456 +} -cleanup {
1.457 + package forget foo
1.458 +} -result 1.1
1.459 +test pkg-2.34.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
1.460 + package forget foo
1.461 +} -body {
1.462 + package ifneeded foo 1.1 {package provide foo 1}
1.463 + package require foo 1
1.464 +} -cleanup {
1.465 + package forget foo
1.466 +} -result 1
1.467 +test pkg-2.34.2 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
1.468 + package forget foo
1.469 +} -body {
1.470 + package ifneeded foo 1.1 {package provide foo 1}
1.471 + package require foo 1.1
1.472 +} -cleanup {
1.473 + package forget foo
1.474 +} -returnCodes error -match glob -result {attempt to provide package * failed:*}
1.475 +test pkg-2.35 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
1.476 + package forget foo
1.477 +} -body {
1.478 + package ifneeded foo 1 {}
1.479 + package require foo 1
1.480 +} -cleanup {
1.481 + package forget foo
1.482 +} -returnCodes error -match glob -result {attempt to provide package * failed:*}
1.483 +test pkg-2.35.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
1.484 + package forget foo
1.485 +} -body {
1.486 + package ifneeded foo 1 {break}
1.487 + package require foo 1
1.488 +} -cleanup {
1.489 + package forget foo
1.490 +} -returnCodes error -match glob \
1.491 +-result {attempt to provide package * failed: bad return code:*}
1.492 +test pkg-2.36 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
1.493 + package forget foo
1.494 +} -body {
1.495 + package ifneeded foo 1 {continue}
1.496 + package require foo 1
1.497 +} -cleanup {
1.498 + package forget foo
1.499 +} -returnCodes error -match glob \
1.500 +-result {attempt to provide package * failed: bad return code:*}
1.501 +test pkg-2.37 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
1.502 + package forget foo
1.503 +} -body {
1.504 + package ifneeded foo 1 {return}
1.505 + package require foo 1
1.506 +} -cleanup {
1.507 + package forget foo
1.508 +} -returnCodes error -match glob \
1.509 +-result {attempt to provide package * failed: bad return code:*}
1.510 +test pkg-2.38 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
1.511 + package forget foo
1.512 +} -body {
1.513 + package ifneeded foo 1 {proc x {} {return -code 10}; x}
1.514 + package require foo 1
1.515 +} -cleanup {
1.516 + rename x {}
1.517 + package forget foo
1.518 +} -returnCodes error -match glob \
1.519 +-result {attempt to provide package * failed: bad return code:*}
1.520 +test pkg-2.39 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
1.521 + package forget foo
1.522 + set saveUnknown [package unknown]
1.523 + package unknown {package provide foo 2 ;#}
1.524 +} -body {
1.525 + package require foo 1
1.526 +} -cleanup {
1.527 + package forget foo
1.528 + package unknown $saveUnknown
1.529 +} -returnCodes error -match glob -result *
1.530 +test pkg-2.40 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
1.531 + package forget foo
1.532 + set saveUnknown [package unknown]
1.533 + package unknown {break ;#}
1.534 +} -body {
1.535 + package require foo 1
1.536 +} -cleanup {
1.537 + package forget foo
1.538 + package unknown $saveUnknown
1.539 +} -returnCodes error -match glob -result {bad return code:*}
1.540 +test pkg-2.41 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
1.541 + package forget foo
1.542 + set saveUnknown [package unknown]
1.543 + package unknown {continue ;#}
1.544 +} -body {
1.545 + package require foo 1
1.546 +} -cleanup {
1.547 + package forget foo
1.548 + package unknown $saveUnknown
1.549 +} -returnCodes error -match glob -result {bad return code:*}
1.550 +test pkg-2.42 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
1.551 + package forget foo
1.552 + set saveUnknown [package unknown]
1.553 + package unknown {return ;#}
1.554 +} -body {
1.555 + package require foo 1
1.556 +} -cleanup {
1.557 + package forget foo
1.558 + package unknown $saveUnknown
1.559 +} -returnCodes error -match glob -result {bad return code:*}
1.560 +test pkg-2.43 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
1.561 + package forget foo
1.562 + set saveUnknown [package unknown]
1.563 + proc x args {return -code 10}
1.564 + package unknown x
1.565 +} -body {
1.566 + package require foo 1
1.567 +} -cleanup {
1.568 + rename x {}
1.569 + package forget foo
1.570 + package unknown $saveUnknown
1.571 +} -returnCodes error -match glob -result {bad return code:*}
1.572 +
1.573 +
1.574 +
1.575 +test pkg-2.50 {Tcl_PkgRequire procedure, picking best stable version} tip268 {
1.576 + package forget t
1.577 + foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} {
1.578 + package ifneeded t $i "set x $i; package provide t $i"
1.579 + }
1.580 + set x xxx
1.581 + package require t
1.582 + set x
1.583 +} {3.4}
1.584 +
1.585 +test pkg-2.51 {Tcl_PkgRequire procedure, picking best stable version} tip268 {
1.586 + package forget t
1.587 + foreach i {1.2b1 1.2 1.3a2 1.3} {
1.588 + package ifneeded t $i "set x $i; package provide t $i"
1.589 + }
1.590 + set x xxx
1.591 + package require t
1.592 + set x
1.593 +} {1.3}
1.594 +
1.595 +test pkg-2.52 {Tcl_PkgRequire procedure, picking best stable version} tip268 {
1.596 + package forget t
1.597 + foreach i {1.2b1 1.2 1.3 1.3a2} {
1.598 + package ifneeded t $i "set x $i; package provide t $i"
1.599 + }
1.600 + set x xxx
1.601 + package require t
1.602 + set x
1.603 +} {1.3}
1.604 +
1.605 +
1.606 +
1.607 +test pkg-3.1 {Tcl_PackageCmd procedure} {
1.608 + list [catch {package} msg] $msg
1.609 +} {1 {wrong # args: should be "package option ?arg arg ...?"}}
1.610 +test pkg-3.2 {Tcl_PackageCmd procedure, "forget" option} {
1.611 + foreach i [package names] {
1.612 + package forget $i
1.613 + }
1.614 + package names
1.615 +} {}
1.616 +test pkg-3.3 {Tcl_PackageCmd procedure, "forget" option} {
1.617 + foreach i [package names] {
1.618 + package forget $i
1.619 + }
1.620 + package forget foo
1.621 +} {}
1.622 +test pkg-3.4 {Tcl_PackageCmd procedure, "forget" option} {
1.623 + foreach i [package names] {
1.624 + package forget $i
1.625 + }
1.626 + package ifneeded t 1.1 {first script}
1.627 + package ifneeded t 2.3 {second script}
1.628 + package ifneeded x 1.4 {x's script}
1.629 + set result {}
1.630 + lappend result [lsort [package names]] [package versions t]
1.631 + package forget t
1.632 + lappend result [lsort [package names]] [package versions t]
1.633 +} {{t x} {1.1 2.3} x {}}
1.634 +test pkg-3.5 {Tcl_PackageCmd procedure, "forget" option} {
1.635 + foreach i [package names] {
1.636 + package forget $i
1.637 + }
1.638 + package ifneeded a 1.1 {first script}
1.639 + package ifneeded b 2.3 {second script}
1.640 + package ifneeded c 1.4 {third script}
1.641 + package forget
1.642 + set result [list [lsort [package names]]]
1.643 + package forget a c
1.644 + lappend result [lsort [package names]]
1.645 +} {{a b c} b}
1.646 +test pkg-3.5.1 {Tcl_PackageCmd procedure, "forget" option} {
1.647 + # Test for Bug 415273
1.648 + package ifneeded a 1 "I should have been forgotten"
1.649 + package forget no-such-package a
1.650 + set x [package ifneeded a 1]
1.651 + package forget a
1.652 + set x
1.653 +} {}
1.654 +test pkg-3.6 {Tcl_PackageCmd procedure, "ifneeded" option} {
1.655 + list [catch {package ifneeded a} msg] $msg
1.656 +} {1 {wrong # args: should be "package ifneeded package version ?script?"}}
1.657 +test pkg-3.7 {Tcl_PackageCmd procedure, "ifneeded" option} {
1.658 + list [catch {package ifneeded a b c d} msg] $msg
1.659 +} {1 {wrong # args: should be "package ifneeded package version ?script?"}}
1.660 +test pkg-3.8 {Tcl_PackageCmd procedure, "ifneeded" option} {
1.661 + list [catch {package ifneeded t xyz} msg] $msg
1.662 +} {1 {expected version number but got "xyz"}}
1.663 +test pkg-3.9 {Tcl_PackageCmd procedure, "ifneeded" option} {
1.664 + foreach i [package names] {
1.665 + package forget $i
1.666 + }
1.667 + list [package ifneeded foo 1.1] [package names]
1.668 +} {{} {}}
1.669 +test pkg-3.10 {Tcl_PackageCmd procedure, "ifneeded" option} {
1.670 + package forget t
1.671 + package ifneeded t 1.4 "script for t 1.4"
1.672 + list [package names] [package ifneeded t 1.4] [package versions t]
1.673 +} {t {script for t 1.4} 1.4}
1.674 +test pkg-3.11 {Tcl_PackageCmd procedure, "ifneeded" option} {
1.675 + package forget t
1.676 + package ifneeded t 1.4 "script for t 1.4"
1.677 + list [package ifneeded t 1.5] [package names] [package versions t]
1.678 +} {{} t 1.4}
1.679 +test pkg-3.12 {Tcl_PackageCmd procedure, "ifneeded" option} {
1.680 + package forget t
1.681 + package ifneeded t 1.4 "script for t 1.4"
1.682 + package ifneeded t 1.4 "second script for t 1.4"
1.683 + list [package ifneeded t 1.4] [package names] [package versions t]
1.684 +} {{second script for t 1.4} t 1.4}
1.685 +test pkg-3.13 {Tcl_PackageCmd procedure, "ifneeded" option} {
1.686 + package forget t
1.687 + package ifneeded t 1.4 "script for t 1.4"
1.688 + package ifneeded t 1.2 "second script"
1.689 + package ifneeded t 3.1 "last script"
1.690 + list [package ifneeded t 1.2] [package versions t]
1.691 +} {{second script} {1.4 1.2 3.1}}
1.692 +test pkg-3.14 {Tcl_PackageCmd procedure, "names" option} {
1.693 + list [catch {package names a} msg] $msg
1.694 +} {1 {wrong # args: should be "package names"}}
1.695 +test pkg-3.15 {Tcl_PackageCmd procedure, "names" option} {
1.696 + foreach i [package names] {
1.697 + package forget $i
1.698 + }
1.699 + package names
1.700 +} {}
1.701 +test pkg-3.16 {Tcl_PackageCmd procedure, "names" option} {
1.702 + foreach i [package names] {
1.703 + package forget $i
1.704 + }
1.705 + package ifneeded x 1.2 {dummy}
1.706 + package provide x 1.3
1.707 + package provide y 2.4
1.708 + catch {package require z 47.16}
1.709 + lsort [package names]
1.710 +} {x y}
1.711 +test pkg-3.17 {Tcl_PackageCmd procedure, "provide" option} {
1.712 + list [catch {package provide} msg] $msg
1.713 +} {1 {wrong # args: should be "package provide package ?version?"}}
1.714 +test pkg-3.18 {Tcl_PackageCmd procedure, "provide" option} {
1.715 + list [catch {package provide a b c} msg] $msg
1.716 +} {1 {wrong # args: should be "package provide package ?version?"}}
1.717 +test pkg-3.19 {Tcl_PackageCmd procedure, "provide" option} {
1.718 + package forget t
1.719 + package provide t
1.720 +} {}
1.721 +test pkg-3.20 {Tcl_PackageCmd procedure, "provide" option} {
1.722 + package forget t
1.723 + package provide t 2.3
1.724 + package provide t
1.725 +} {2.3}
1.726 +test pkg-3.21 {Tcl_PackageCmd procedure, "provide" option} {
1.727 + package forget t
1.728 + list [catch {package provide t a.b} msg] $msg
1.729 +} {1 {expected version number but got "a.b"}}
1.730 +test pkg-3.22 {Tcl_PackageCmd procedure, "require" option} !tip268 {
1.731 + list [catch {package require} msg] $msg
1.732 +} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
1.733 +test pkg-3.22-268 {Tcl_PackageCmd procedure, "require" option} tip268 {
1.734 + list [catch {package require} msg] $msg
1.735 +} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}
1.736 +test pkg-3.23 {Tcl_PackageCmd procedure, "require" option} !tip268 {
1.737 + list [catch {package require a b c} msg] $msg
1.738 +} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
1.739 +test pkg-3.24 {Tcl_PackageCmd procedure, "require" option} !tip268 {
1.740 + list [catch {package require -exact a b c} msg] $msg
1.741 +} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
1.742 +test pkg-3.24-268 {Tcl_PackageCmd procedure, "require" option} tip268 {
1.743 + list [catch {package require -exact a b c} msg] $msg
1.744 + # Exact syntax: -exact name version
1.745 + # name ?requirement...?
1.746 +} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}
1.747 +test pkg-3.25 {Tcl_PackageCmd procedure, "require" option} !tip268 {
1.748 + list [catch {package require -bs a b} msg] $msg
1.749 +} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
1.750 +test pkg-3.26 {Tcl_PackageCmd procedure, "require" option} {
1.751 + list [catch {package require x a.b} msg] $msg
1.752 +} {1 {expected version number but got "a.b"}}
1.753 +test pkg-3.27 {Tcl_PackageCmd procedure, "require" option} {
1.754 + list [catch {package require -exact x a.b} msg] $msg
1.755 +} {1 {expected version number but got "a.b"}}
1.756 +test pkg-3.28 {Tcl_PackageCmd procedure, "require" option} !tip268 {
1.757 + list [catch {package require -exact x} msg] $msg
1.758 +} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
1.759 +test pkg-3.28-268 {Tcl_PackageCmd procedure, "require" option} tip268 {
1.760 + list [catch {package require -exact x} msg] $msg
1.761 +} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}
1.762 +test pkg-3.29 {Tcl_PackageCmd procedure, "require" option} !tip268 {
1.763 + list [catch {package require -exact} msg] $msg
1.764 +} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
1.765 +test pkg-3.29-268 {Tcl_PackageCmd procedure, "require" option} tip268 {
1.766 + list [catch {package require -exact} msg] $msg
1.767 +} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}
1.768 +test pkg-3.30 {Tcl_PackageCmd procedure, "require" option} {
1.769 + package forget t
1.770 + package provide t 2.3
1.771 + package require t 2.1
1.772 +} {2.3}
1.773 +test pkg-3.31 {Tcl_PackageCmd procedure, "require" option} {
1.774 + package forget t
1.775 + list [catch {package require t} msg] $msg
1.776 +} {1 {can't find package t}}
1.777 +test pkg-3.32 {Tcl_PackageCmd procedure, "require" option} {
1.778 + package forget t
1.779 + package ifneeded t 2.3 "error {synthetic error}"
1.780 + list [catch {package require t 2.3} msg] $msg
1.781 +} {1 {synthetic error}}
1.782 +test pkg-3.33 {Tcl_PackageCmd procedure, "unknown" option} {
1.783 + list [catch {package unknown a b} msg] $msg
1.784 +} {1 {wrong # args: should be "package unknown ?command?"}}
1.785 +test pkg-3.34 {Tcl_PackageCmd procedure, "unknown" option} {
1.786 + package unknown "test script"
1.787 + package unknown
1.788 +} {test script}
1.789 +test pkg-3.35 {Tcl_PackageCmd procedure, "unknown" option} {
1.790 + package unknown "test script"
1.791 + package unknown {}
1.792 + package unknown
1.793 +} {}
1.794 +test pkg-3.36 {Tcl_PackageCmd procedure, "vcompare" option} {
1.795 + list [catch {package vcompare a} msg] $msg
1.796 +} {1 {wrong # args: should be "package vcompare version1 version2"}}
1.797 +test pkg-3.37 {Tcl_PackageCmd procedure, "vcompare" option} {
1.798 + list [catch {package vcompare a b c} msg] $msg
1.799 +} {1 {wrong # args: should be "package vcompare version1 version2"}}
1.800 +test pkg-3.38 {Tcl_PackageCmd procedure, "vcompare" option} {
1.801 + list [catch {package vcompare x.y 3.4} msg] $msg
1.802 +} {1 {expected version number but got "x.y"}}
1.803 +test pkg-3.39 {Tcl_PackageCmd procedure, "vcompare" option} {
1.804 + list [catch {package vcompare 2.1 a.b} msg] $msg
1.805 +} {1 {expected version number but got "a.b"}}
1.806 +test pkg-3.40 {Tcl_PackageCmd procedure, "vcompare" option} {
1.807 + package vc 2.1 2.3
1.808 +} {-1}
1.809 +test pkg-3.41 {Tcl_PackageCmd procedure, "vcompare" option} {
1.810 + package vc 2.2.4 2.2.4
1.811 +} {0}
1.812 +test pkg-3.42 {Tcl_PackageCmd procedure, "versions" option} {
1.813 + list [catch {package versions} msg] $msg
1.814 +} {1 {wrong # args: should be "package versions package"}}
1.815 +test pkg-3.43 {Tcl_PackageCmd procedure, "versions" option} {
1.816 + list [catch {package versions a b} msg] $msg
1.817 +} {1 {wrong # args: should be "package versions package"}}
1.818 +test pkg-3.44 {Tcl_PackageCmd procedure, "versions" option} {
1.819 + package forget t
1.820 + package versions t
1.821 +} {}
1.822 +test pkg-3.45 {Tcl_PackageCmd procedure, "versions" option} {
1.823 + package forget t
1.824 + package provide t 2.3
1.825 + package versions t
1.826 +} {}
1.827 +test pkg-3.46 {Tcl_PackageCmd procedure, "versions" option} {
1.828 + package forget t
1.829 + package ifneeded t 2.3 x
1.830 + package ifneeded t 2.4 y
1.831 + package versions t
1.832 +} {2.3 2.4}
1.833 +test pkg-3.47 {Tcl_PackageCmd procedure, "vsatisfies" option} !tip268 {
1.834 + list [catch {package vsatisfies a} msg] $msg
1.835 +} {1 {wrong # args: should be "package vsatisfies version1 version2"}}
1.836 +test pkg-3.47-268 {Tcl_PackageCmd procedure, "vsatisfies" option} tip268 {
1.837 + list [catch {package vsatisfies a} msg] $msg
1.838 +} {1 {wrong # args: should be "package vsatisfies version requirement requirement..."}}
1.839 +test pkg-3.48 {Tcl_PackageCmd procedure, "vsatisfies" option} !tip268 {
1.840 + list [catch {package vsatisfies a b c} msg] $msg
1.841 +} {1 {wrong # args: should be "package vsatisfies version1 version2"}}
1.842 +test pkg-3.49 {Tcl_PackageCmd procedure, "vsatisfies" option} {
1.843 + list [catch {package vsatisfies x.y 3.4} msg] $msg
1.844 +} {1 {expected version number but got "x.y"}}
1.845 +test pkg-3.50 {Tcl_PackageCmd procedure, "vsatisfies" option} {
1.846 + list [catch {package vcompare 2.1 a.b} msg] $msg
1.847 +} {1 {expected version number but got "a.b"}}
1.848 +test pkg-3.51 {Tcl_PackageCmd procedure, "vsatisfies" option} {
1.849 + package vs 2.3 2.1
1.850 +} {1}
1.851 +test pkg-3.52 {Tcl_PackageCmd procedure, "vsatisfies" option} {
1.852 + package vs 2.3 1.2
1.853 +} {0}
1.854 +test pkg-3.53 {Tcl_PackageCmd procedure, "versions" option} !tip268 {
1.855 + list [catch {package foo} msg] $msg
1.856 +} {1 {bad option "foo": must be forget, ifneeded, names, present, provide, require, unknown, vcompare, versions, or vsatisfies}}
1.857 +test pkg-3.53-268 {Tcl_PackageCmd procedure, "versions" option} tip268 {
1.858 + list [catch {package foo} msg] $msg
1.859 +} {1 {bad option "foo": must be forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies}}
1.860 +
1.861 +test pkg-3.54 {Tcl_PackageCmd procedure, "vsatisfies" option} tip268 {
1.862 + list [catch {package vsatisfies 2.1 2.1-3.2-4.5} msg] $msg
1.863 +} {1 {expected versionMin-versionMax but got "2.1-3.2-4.5"}}
1.864 +
1.865 +test pkg-3.55 {Tcl_PackageCmd procedure, "vsatisfies" option} tip268 {
1.866 + list [catch {package vsatisfies 2.1 3.2-x.y} msg] $msg
1.867 +} {1 {expected version number but got "x.y"}}
1.868 +
1.869 +test pkg-3.56 {Tcl_PackageCmd procedure, "vsatisfies" option} tip268 {
1.870 + list [catch {package vsatisfies 2.1 x.y-3.2} msg] $msg
1.871 +} {1 {expected version number but got "x.y"}}
1.872 +
1.873 +# No tests for FindPackage; can't think up anything detectable
1.874 +# errors.
1.875 +
1.876 +test pkg-4.1 {TclFreePackageInfo procedure} {
1.877 + interp create foo
1.878 + foo eval {
1.879 + package ifneeded t 2.3 x
1.880 + package ifneeded t 2.4 y
1.881 + package ifneeded x 3.1 z
1.882 + package provide q 4.3
1.883 + package unknown "will this get freed?"
1.884 + }
1.885 + interp delete foo
1.886 +} {}
1.887 +test pkg-4.2 {TclFreePackageInfo procedure} -body {
1.888 + interp create foo
1.889 + foo eval {
1.890 + package ifneeded t 2.3 x
1.891 + package ifneeded t 2.4 y
1.892 + package ifneeded x 3.1 z
1.893 + package provide q 4.3
1.894 + }
1.895 + foo alias z kill
1.896 + proc kill {} {
1.897 + interp delete foo
1.898 + }
1.899 + foo eval package require x 3.1
1.900 +} -returnCodes error -match glob -result *
1.901 +
1.902 +test pkg-5.1 {CheckVersion procedure} {
1.903 + list [catch {package vcompare 1 2.1} msg] $msg
1.904 +} {0 -1}
1.905 +test pkg-5.2 {CheckVersion procedure} {
1.906 + list [catch {package vcompare .1 2.1} msg] $msg
1.907 +} {1 {expected version number but got ".1"}}
1.908 +test pkg-5.3 {CheckVersion procedure} {
1.909 + list [catch {package vcompare 111.2a.3 2.1} msg] $msg
1.910 +} {1 {expected version number but got "111.2a.3"}}
1.911 +test pkg-5.4 {CheckVersion procedure} {
1.912 + list [catch {package vcompare 1.2.3. 2.1} msg] $msg
1.913 +} {1 {expected version number but got "1.2.3."}}
1.914 +test pkg-5.5 {CheckVersion procedure} {
1.915 + list [catch {package vcompare 1.2..3 2.1} msg] $msg
1.916 +} {1 {expected version number but got "1.2..3"}}
1.917 +
1.918 +test pkg-6.1 {ComparePkgVersions procedure} {
1.919 + package vcompare 1.23 1.22
1.920 +} {1}
1.921 +test pkg-6.2 {ComparePkgVersions procedure} {
1.922 + package vcompare 1.22.1.2.3 1.22.1.2.3
1.923 +} {0}
1.924 +test pkg-6.3 {ComparePkgVersions procedure} {
1.925 + package vcompare 1.21 1.22
1.926 +} {-1}
1.927 +test pkg-6.4 {ComparePkgVersions procedure} {
1.928 + package vcompare 1.21 1.21.2
1.929 +} {-1}
1.930 +test pkg-6.5 {ComparePkgVersions procedure} {
1.931 + package vcompare 1.21.1 1.21
1.932 +} {1}
1.933 +test pkg-6.6 {ComparePkgVersions procedure} {
1.934 + package vsatisfies 1.21.1 1.21
1.935 +} {1}
1.936 +test pkg-6.7 {ComparePkgVersions procedure} {
1.937 + package vsatisfies 2.22.3 1.21
1.938 +} {0}
1.939 +test pkg-6.8 {ComparePkgVersions procedure} {
1.940 + package vsatisfies 1 1
1.941 +} {1}
1.942 +test pkg-6.9 {ComparePkgVersions procedure} {
1.943 + package vsatisfies 2 1
1.944 +} {0}
1.945 +
1.946 +test pkg-7.1 {Tcl_PkgPresent procedure, any version} {
1.947 + package forget t
1.948 + package provide t 2.4
1.949 + package present t
1.950 +} {2.4}
1.951 +test pkg-7.2 {Tcl_PkgPresent procedure, correct version} {
1.952 + package forget t
1.953 + package provide t 2.4
1.954 + package present t 2.4
1.955 +} {2.4}
1.956 +test pkg-7.3 {Tcl_PkgPresent procedure, satisfying version} {
1.957 + package forget t
1.958 + package provide t 2.4
1.959 + package present t 2.0
1.960 +} {2.4}
1.961 +test pkg-7.4 {Tcl_PkgPresent procedure, not satisfying version} {
1.962 + package forget t
1.963 + package provide t 2.4
1.964 + list [catch {package present t 2.6} msg] $msg
1.965 +} {1 {version conflict for package "t": have 2.4, need 2.6}}
1.966 +test pkg-7.5 {Tcl_PkgPresent procedure, not satisfying version} {
1.967 + package forget t
1.968 + package provide t 2.4
1.969 + list [catch {package present t 1.0} msg] $msg
1.970 +} {1 {version conflict for package "t": have 2.4, need 1.0}}
1.971 +test pkg-7.6 {Tcl_PkgPresent procedure, exact version} {
1.972 + package forget t
1.973 + package provide t 2.4
1.974 + package present -exact t 2.4
1.975 +} {2.4}
1.976 +test pkg-7.7 {Tcl_PkgPresent procedure, not exact version} {
1.977 + package forget t
1.978 + package provide t 2.4
1.979 + list [catch {package present -exact t 2.3} msg] $msg
1.980 +} {1 {version conflict for package "t": have 2.4, need 2.3}}
1.981 +test pkg-7.8 {Tcl_PkgPresent procedure, unknown package} {
1.982 + package forget t
1.983 + list [catch {package present t} msg] $msg
1.984 +} {1 {package t is not present}}
1.985 +test pkg-7.9 {Tcl_PkgPresent procedure, unknown package} {
1.986 + package forget t
1.987 + list [catch {package present t 2.4} msg] $msg
1.988 +} {1 {package t 2.4 is not present}}
1.989 +test pkg-7.10 {Tcl_PkgPresent procedure, unknown package} {
1.990 + package forget t
1.991 + list [catch {package present -exact t 2.4} msg] $msg
1.992 +} {1 {package t 2.4 is not present}}
1.993 +test pkg-7.11 {Tcl_PackageCmd procedure, "present" option} {
1.994 + list [catch {package present} msg] $msg
1.995 +} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
1.996 +test pkg-7.12 {Tcl_PackageCmd procedure, "present" option} {
1.997 + list [catch {package present a b c} msg] $msg
1.998 +} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
1.999 +test pkg-7.13 {Tcl_PackageCmd procedure, "present" option} {
1.1000 + list [catch {package present -exact a b c} msg] $msg
1.1001 +} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
1.1002 +test pkg-7.14 {Tcl_PackageCmd procedure, "present" option} {
1.1003 + list [catch {package present -bs a b} msg] $msg
1.1004 +} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
1.1005 +test pkg-7.15 {Tcl_PackageCmd procedure, "present" option} {
1.1006 + list [catch {package present x a.b} msg] $msg
1.1007 +} {1 {expected version number but got "a.b"}}
1.1008 +test pkg-7.16 {Tcl_PackageCmd procedure, "present" option} {
1.1009 + list [catch {package present -exact x a.b} msg] $msg
1.1010 +} {1 {expected version number but got "a.b"}}
1.1011 +test pkg-7.17 {Tcl_PackageCmd procedure, "present" option} {
1.1012 + list [catch {package present -exact x} msg] $msg
1.1013 +} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
1.1014 +test pkg-7.18 {Tcl_PackageCmd procedure, "present" option} {
1.1015 + list [catch {package present -exact} msg] $msg
1.1016 +} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
1.1017 +
1.1018 +
1.1019 +# Note: It is correct that the result of the very first test,
1.1020 +# i.e. "5.0 5.0a0" is 1, i.e. that version 5.0a0 satisfies a 5.0
1.1021 +# requirement.
1.1022 +
1.1023 +# The requirement "5.0" internally translates first to "5.0-6", and
1.1024 +# then to its final form of "5.0a0-6a0". These translations are
1.1025 +# explicitly specified by the TIP (Search for "padded/extended
1.1026 +# internally with 'a0'"). This was done intentionally for exactly the
1.1027 +# tested case, that an alpha package can satisfy a requirement for the
1.1028 +# regular package. An example would be a package FOO requiring Tcl 8.X
1.1029 +# for its operation. It can be used with Tcl 8.Xa0. Without our
1.1030 +# translation that would not be possible.
1.1031 +
1.1032 +set n 0
1.1033 +foreach {r p vs vc} {
1.1034 + 5.0 5.0a0 1 1
1.1035 + 5.0a0 5.0 1 -1
1.1036 +
1.1037 + 8.5a0 8.5a5 1 -1
1.1038 + 8.5a0 8.5b1 1 -1
1.1039 + 8.5a0 8.5.1 1 -1
1.1040 + 8.5a0 8.6a0 1 -1
1.1041 + 8.5a0 8.6b0 1 -1
1.1042 + 8.5a0 8.6.0 1 -1
1.1043 + 8.5a6 8.5a5 0 1
1.1044 + 8.5a6 8.5b1 1 -1
1.1045 + 8.5a6 8.5.1 1 -1
1.1046 + 8.5a6 8.6a0 1 -1
1.1047 + 8.5a6 8.6b0 1 -1
1.1048 + 8.5a6 8.6.0 1 -1
1.1049 + 8.5b0 8.5a5 0 1
1.1050 + 8.5b0 8.5b1 1 -1
1.1051 + 8.5b0 8.5.1 1 -1
1.1052 + 8.5b0 8.6a0 1 -1
1.1053 + 8.5b0 8.6b0 1 -1
1.1054 + 8.5b0 8.6.0 1 -1
1.1055 + 8.5b2 8.5a5 0 1
1.1056 + 8.5b2 8.5b1 0 1
1.1057 + 8.5b2 8.5.1 1 -1
1.1058 + 8.5b2 8.6a0 1 -1
1.1059 + 8.5b2 8.6b0 1 -1
1.1060 + 8.5b2 8.6.0 1 -1
1.1061 + 8.5 8.5a5 1 1
1.1062 + 8.5 8.5b1 1 1
1.1063 + 8.5 8.5.1 1 -1
1.1064 + 8.5 8.6a0 1 -1
1.1065 + 8.5 8.6b0 1 -1
1.1066 + 8.5 8.6.0 1 -1
1.1067 + 8.5.0 8.5a5 0 1
1.1068 + 8.5.0 8.5b1 0 1
1.1069 + 8.5.0 8.5.1 1 -1
1.1070 + 8.5.0 8.6a0 1 -1
1.1071 + 8.5.0 8.6b0 1 -1
1.1072 + 8.5.0 8.6.0 1 -1
1.1073 +} {
1.1074 + test package-vsatisfies-1.$n {package vsatisfies} tip268 {
1.1075 + package vsatisfies $p $r
1.1076 + } $vs
1.1077 +
1.1078 + test package-vcompare-1.$n {package vcompare} tip268 {
1.1079 + package vcompare $r $p
1.1080 + } $vc
1.1081 +
1.1082 + incr n
1.1083 +}
1.1084 +
1.1085 +set n 0
1.1086 +foreach {required provided satisfied} {
1.1087 + 8.5a0- 8.5a5 1
1.1088 + 8.5a0- 8.5b1 1
1.1089 + 8.5a0- 8.5.1 1
1.1090 + 8.5a0- 8.6a0 1
1.1091 + 8.5a0- 8.6b0 1
1.1092 + 8.5a0- 8.6.0 1
1.1093 + 8.5a6- 8.5a5 0
1.1094 + 8.5a6- 8.5b1 1
1.1095 + 8.5a6- 8.5.1 1
1.1096 + 8.5a6- 8.6a0 1
1.1097 + 8.5a6- 8.6b0 1
1.1098 + 8.5a6- 8.6.0 1
1.1099 + 8.5b0- 8.5a5 0
1.1100 + 8.5b0- 8.5b1 1
1.1101 + 8.5b0- 8.5.1 1
1.1102 + 8.5b0- 8.6a0 1
1.1103 + 8.5b0- 8.6b0 1
1.1104 + 8.5b0- 8.6.0 1
1.1105 + 8.5b2- 8.5a5 0
1.1106 + 8.5b2- 8.5b1 0
1.1107 + 8.5b2- 8.5.1 1
1.1108 + 8.5b2- 8.6a0 1
1.1109 + 8.5b2- 8.6b0 1
1.1110 + 8.5b2- 8.6.0 1
1.1111 + 8.5- 8.5a5 1
1.1112 + 8.5- 8.5b1 1
1.1113 + 8.5- 8.5.1 1
1.1114 + 8.5- 8.6a0 1
1.1115 + 8.5- 8.6b0 1
1.1116 + 8.5- 8.6.0 1
1.1117 + 8.5.0- 8.5a5 0
1.1118 + 8.5.0- 8.5b1 0
1.1119 + 8.5.0- 8.5.1 1
1.1120 + 8.5.0- 8.6a0 1
1.1121 + 8.5.0- 8.6b0 1
1.1122 + 8.5.0- 8.6.0 1
1.1123 + 8.5a0-7 8.5a5 0
1.1124 + 8.5a0-7 8.5b1 0
1.1125 + 8.5a0-7 8.5.1 0
1.1126 + 8.5a0-7 8.6a0 0
1.1127 + 8.5a0-7 8.6b0 0
1.1128 + 8.5a0-7 8.6.0 0
1.1129 + 8.5a6-7 8.5a5 0
1.1130 + 8.5a6-7 8.5b1 0
1.1131 + 8.5a6-7 8.5.1 0
1.1132 + 8.5a6-7 8.6a0 0
1.1133 + 8.5a6-7 8.6b0 0
1.1134 + 8.5a6-7 8.6.0 0
1.1135 + 8.5b0-7 8.5a5 0
1.1136 + 8.5b0-7 8.5b1 0
1.1137 + 8.5b0-7 8.5.1 0
1.1138 + 8.5b0-7 8.6a0 0
1.1139 + 8.5b0-7 8.6b0 0
1.1140 + 8.5b0-7 8.6.0 0
1.1141 + 8.5b2-7 8.5a5 0
1.1142 + 8.5b2-7 8.5b1 0
1.1143 + 8.5b2-7 8.5.1 0
1.1144 + 8.5b2-7 8.6a0 0
1.1145 + 8.5b2-7 8.6b0 0
1.1146 + 8.5b2-7 8.6.0 0
1.1147 + 8.5-7 8.5a5 0
1.1148 + 8.5-7 8.5b1 0
1.1149 + 8.5-7 8.5.1 0
1.1150 + 8.5-7 8.6a0 0
1.1151 + 8.5-7 8.6b0 0
1.1152 + 8.5-7 8.6.0 0
1.1153 + 8.5.0-7 8.5a5 0
1.1154 + 8.5.0-7 8.5b1 0
1.1155 + 8.5.0-7 8.5.1 0
1.1156 + 8.5.0-7 8.6a0 0
1.1157 + 8.5.0-7 8.6b0 0
1.1158 + 8.5.0-7 8.6.0 0
1.1159 + 8.5a0-8.6.1 8.5a5 1
1.1160 + 8.5a0-8.6.1 8.5b1 1
1.1161 + 8.5a0-8.6.1 8.5.1 1
1.1162 + 8.5a0-8.6.1 8.6a0 1
1.1163 + 8.5a0-8.6.1 8.6b0 1
1.1164 + 8.5a0-8.6.1 8.6.0 1
1.1165 + 8.5a6-8.6.1 8.5a5 0
1.1166 + 8.5a6-8.6.1 8.5b1 1
1.1167 + 8.5a6-8.6.1 8.5.1 1
1.1168 + 8.5a6-8.6.1 8.6a0 1
1.1169 + 8.5a6-8.6.1 8.6b0 1
1.1170 + 8.5a6-8.6.1 8.6.0 1
1.1171 + 8.5b0-8.6.1 8.5a5 0
1.1172 + 8.5b0-8.6.1 8.5b1 1
1.1173 + 8.5b0-8.6.1 8.5.1 1
1.1174 + 8.5b0-8.6.1 8.6a0 1
1.1175 + 8.5b0-8.6.1 8.6b0 1
1.1176 + 8.5b0-8.6.1 8.6.0 1
1.1177 + 8.5b2-8.6.1 8.5a5 0
1.1178 + 8.5b2-8.6.1 8.5b1 0
1.1179 + 8.5b2-8.6.1 8.5.1 1
1.1180 + 8.5b2-8.6.1 8.6a0 1
1.1181 + 8.5b2-8.6.1 8.6b0 1
1.1182 + 8.5b2-8.6.1 8.6.0 1
1.1183 + 8.5-8.6.1 8.5a5 1
1.1184 + 8.5-8.6.1 8.5b1 1
1.1185 + 8.5-8.6.1 8.5.1 1
1.1186 + 8.5-8.6.1 8.6a0 1
1.1187 + 8.5-8.6.1 8.6b0 1
1.1188 + 8.5-8.6.1 8.6.0 1
1.1189 + 8.5.0-8.6.1 8.5a5 0
1.1190 + 8.5.0-8.6.1 8.5b1 0
1.1191 + 8.5.0-8.6.1 8.5.1 1
1.1192 + 8.5.0-8.6.1 8.6a0 1
1.1193 + 8.5.0-8.6.1 8.6b0 1
1.1194 + 8.5.0-8.6.1 8.6.0 1
1.1195 + 8.5a0-8.5a0 8.5a0 1
1.1196 + 8.5a0-8.5a0 8.5b1 0
1.1197 + 8.5a0-8.5a0 8.4 0
1.1198 + 8.5b0-8.5b0 8.5a5 0
1.1199 + 8.5b0-8.5b0 8.5b0 1
1.1200 + 8.5b0-8.5b0 8.5.1 0
1.1201 + 8.5-8.5 8.5a5 0
1.1202 + 8.5-8.5 8.5b1 0
1.1203 + 8.5-8.5 8.5 1
1.1204 + 8.5-8.5 8.5.1 0
1.1205 + 8.5.0-8.5.0 8.5a5 0
1.1206 + 8.5.0-8.5.0 8.5b1 0
1.1207 + 8.5.0-8.5.0 8.5.0 1
1.1208 + 8.5.0-8.5.0 8.5.1 0
1.1209 + 8.5.0-8.5.0 8.6a0 0
1.1210 + 8.5.0-8.5.0 8.6b0 0
1.1211 + 8.5.0-8.5.0 8.6.0 0
1.1212 + 8.2 9 0
1.1213 + 8.2- 9 1
1.1214 + 8.2-8.5 9 0
1.1215 + 8.2-9.1 9 1
1.1216 +
1.1217 + 8.5-8.5 8.5b1 0
1.1218 + 8.5a0-8.5 8.5b1 0
1.1219 + 8.5a0-8.5.1 8.5b1 1
1.1220 +
1.1221 + 8.5-8.5 8.5 1
1.1222 + 8.5.0-8.5.0 8.5 1
1.1223 + 8.5a0-8.5.0 8.5 0
1.1224 +
1.1225 +} {
1.1226 + test package-vsatisfies-2.$n "package vsatisfies $provided $required" tip268 {
1.1227 + package vsatisfies $provided $required
1.1228 + } $satisfied
1.1229 + incr n
1.1230 +}
1.1231 +
1.1232 +test package-vsatisfies-3.0 "package vsatisfies multiple" tip268 {
1.1233 + # yes no
1.1234 + package vsatisfies 8.4 8.4 7.3
1.1235 +} 1
1.1236 +
1.1237 +test package-vsatisfies-3.1 "package vsatisfies multiple" tip268 {
1.1238 + # no yes
1.1239 + package vsatisfies 8.4 7.3 8.4
1.1240 +} 1
1.1241 +
1.1242 +test package-vsatisfies-3.2 "package vsatisfies multiple" tip268 {
1.1243 + # yes yes
1.1244 + package vsatisfies 8.4.2 8.4 8.4.1
1.1245 +} 1
1.1246 +
1.1247 +test package-vsatisfies-3.3 "package vsatisfies multiple" tip268 {
1.1248 + # no no
1.1249 + package vsatisfies 8.4 7.3 6.1
1.1250 +} 0
1.1251 +
1.1252 +
1.1253 +proc prefer {args} {
1.1254 + set ip [interp create]
1.1255 + lappend res [$ip eval {package prefer}]
1.1256 + foreach mode $args {
1.1257 + lappend res [$ip eval [list package prefer $mode]]
1.1258 + }
1.1259 + interp delete $ip
1.1260 + return $res
1.1261 +}
1.1262 +
1.1263 +test package-prefer-1.0 {default} tip268 {
1.1264 + prefer
1.1265 +} stable
1.1266 +
1.1267 +test package-prefer-1.1 {default} tip268 {
1.1268 + set ::env(TCL_PKG_PREFER_LATEST) stable ; # value not relevant!
1.1269 + set res [prefer]
1.1270 + unset ::env(TCL_PKG_PREFER_LATEST)
1.1271 + set res
1.1272 +} latest
1.1273 +
1.1274 +test package-prefer-2.0 {wrong\#args} tip268 {
1.1275 + catch {package prefer foo bar} msg
1.1276 + set msg
1.1277 +} {wrong # args: should be "package prefer ?latest|stable?"}
1.1278 +
1.1279 +test package-prefer-2.1 {bogus argument} tip268 {
1.1280 + catch {package prefer foo} msg
1.1281 + set msg
1.1282 +} {bad preference "foo": must be latest or stable}
1.1283 +
1.1284 +test package-prefer-3.0 {set, keep} tip268 {
1.1285 + package prefer stable
1.1286 +} stable
1.1287 +
1.1288 +test package-prefer-3.1 {set stable, keep} tip268 {
1.1289 + prefer stable
1.1290 +} {stable stable}
1.1291 +
1.1292 +test package-prefer-3.2 {set latest, change} tip268 {
1.1293 + prefer latest
1.1294 +} {stable latest}
1.1295 +
1.1296 +test package-prefer-3.3 {set latest, keep} tip268 {
1.1297 + prefer latest latest
1.1298 +} {stable latest latest}
1.1299 +
1.1300 +test package-prefer-3.4 {set stable, rejected} tip268 {
1.1301 + prefer latest stable
1.1302 +} {stable latest latest}
1.1303 +
1.1304 +rename prefer {}
1.1305 +
1.1306 +
1.1307 +set auto_path $oldPath
1.1308 +package unknown $oldPkgUnknown
1.1309 +concat
1.1310 +
1.1311 +cleanupTests
1.1312 +}
1.1313 +
1.1314 +# cleanup
1.1315 +interp delete $i
1.1316 +::tcltest::cleanupTests
1.1317 +return