sl@0: # Commands covered:  pkg
sl@0: #
sl@0: # This file contains a collection of tests for one or more of the Tcl
sl@0: # built-in commands.  Sourcing this file into Tcl runs the tests and
sl@0: # generates output for errors.  No output means no errors were found.
sl@0: #
sl@0: # Copyright (c) 1995-1996 Sun Microsystems, Inc.
sl@0: # Copyright (c) 1998-1999 by Scriptics Corporation.
sl@0: #
sl@0: # See the file "license.terms" for information on usage and redistribution
sl@0: # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0: #
sl@0: # RCS: @(#) $Id: pkg.test,v 1.9.12.10 2007/02/22 20:25:29 andreas_kupries Exp $
sl@0: 
sl@0: if {[lsearch [namespace children] ::tcltest] == -1} {
sl@0:     package require tcltest 2
sl@0:     namespace import -force ::tcltest::*
sl@0: }
sl@0: 
sl@0: # Do all this in a slave interp to avoid garbaging the
sl@0: # package list
sl@0: set i [interp create]
sl@0: interp eval $i [list set argv $argv]
sl@0: interp eval $i [list package require tcltest 2]
sl@0: interp eval $i [list namespace import -force ::tcltest::*]
sl@0: interp eval $i {
sl@0: 
sl@0: eval package forget [package names]
sl@0: set oldPkgUnknown [package unknown]
sl@0: package unknown {}
sl@0: set oldPath $auto_path
sl@0: set auto_path ""
sl@0: 
sl@0: testConstraint tip268  [info exists tcl_platform(tip,268)]
sl@0: testConstraint !tip268 [expr {![info exists tcl_platform(tip,268)]}]
sl@0: 
sl@0: test pkg-1.1 {Tcl_PkgProvide procedure} {
sl@0:     package forget t
sl@0:     package provide t 2.3
sl@0: } {}
sl@0: test pkg-1.2 {Tcl_PkgProvide procedure} {
sl@0:     package forget t
sl@0:     package provide t 2.3
sl@0:     list [catch {package provide t 2.2} msg] $msg
sl@0: } {1 {conflicting versions provided for package "t": 2.3, then 2.2}}
sl@0: test pkg-1.3 {Tcl_PkgProvide procedure} {
sl@0:     package forget t
sl@0:     package provide t 2.3
sl@0:     list [catch {package provide t 2.4} msg] $msg
sl@0: } {1 {conflicting versions provided for package "t": 2.3, then 2.4}}
sl@0: test pkg-1.4 {Tcl_PkgProvide procedure} {
sl@0:     package forget t
sl@0:     package provide t 2.3
sl@0:     list [catch {package provide t 3.3} msg] $msg
sl@0: } {1 {conflicting versions provided for package "t": 2.3, then 3.3}}
sl@0: test pkg-1.5 {Tcl_PkgProvide procedure} {
sl@0:     package forget t
sl@0:     package provide t 2.3
sl@0:     package provide t 2.3
sl@0: } {}
sl@0: 
sl@0: test pkg-1.6 {Tcl_PkgProvide procedure} tip268 {
sl@0:     package forget t
sl@0:     package provide t 2.3a1
sl@0: } {}
sl@0: 
sl@0: set n 0
sl@0: foreach v {
sl@0:     2.3k1 2a3a2 2ab3 2.a4 2.b4 2b.4 2a.4 2ba4 2a4b1
sl@0:     2b4a1 2b3b2
sl@0: } {
sl@0:     test pkg-1.7.$n {Tcl_PkgProvide procedure} tip268 {
sl@0: 	package forget t
sl@0: 	list [catch {package provide t $v} msg] $msg
sl@0:     } [list 1 "expected version number but got \"$v\""]
sl@0:     incr n
sl@0: }
sl@0: 
sl@0: test pkg-2.1 {Tcl_PkgRequire procedure, picking best version} {
sl@0:     package forget t
sl@0:     foreach i {1.4 3.4 2.3 2.4 2.2} {
sl@0: 	package ifneeded t $i "set x $i; package provide t $i"
sl@0:     }
sl@0:     set x xxx
sl@0:     package require t
sl@0:     set x
sl@0: } {3.4}
sl@0: test pkg-2.2 {Tcl_PkgRequire procedure, picking best version} {
sl@0:     package forget t
sl@0:     foreach i {1.4 3.4 2.3 2.4 2.2 3.5 3.2} {
sl@0: 	package ifneeded t $i "set x $i; package provide t $i"
sl@0:     }
sl@0:     set x xxx
sl@0:     package require t
sl@0:     set x
sl@0: } {3.5}
sl@0: test pkg-2.3 {Tcl_PkgRequire procedure, picking best version} {
sl@0:     package forget t
sl@0:     foreach i {3.5 2.1 2.3} {
sl@0: 	package ifneeded t $i "set x $i; package provide t $i"
sl@0:     }
sl@0:     set x xxx
sl@0:     package require t 2.2
sl@0:     set x
sl@0: } {2.3}
sl@0: test pkg-2.4 {Tcl_PkgRequire procedure, picking best version} {
sl@0:     package forget t
sl@0:     foreach i {1.4 3.4 2.3 2.4 2.2} {
sl@0: 	package ifneeded t $i "set x $i; package provide t $i"
sl@0:     }
sl@0:     set x xxx
sl@0:     package require -exact t 2.3
sl@0:     set x
sl@0: } {2.3}
sl@0: test pkg-2.5 {Tcl_PkgRequire procedure, picking best version} {
sl@0:     package forget t
sl@0:     foreach i {1.4 3.4 2.3 2.4 2.2} {
sl@0: 	package ifneeded t $i "set x $i; package provide t $i"
sl@0:     }
sl@0:     set x xxx
sl@0:     package require t 2.1
sl@0:     set x
sl@0: } {2.4}
sl@0: test pkg-2.6 {Tcl_PkgRequire procedure, can't find suitable version} {
sl@0:     package forget t
sl@0:     package unknown {}
sl@0:     foreach i {1.4 3.4 2.3 2.4 2.2} {
sl@0: 	package ifneeded t $i "set x $i"
sl@0:     }
sl@0:     list [catch {package require t 2.5} msg] $msg
sl@0: } {1 {can't find package t 2.5}}
sl@0: test pkg-2.7 {Tcl_PkgRequire procedure, can't find suitable version} {
sl@0:     package forget t
sl@0:     package unknown {}
sl@0:     foreach i {1.4 3.4 2.3 2.4 2.2} {
sl@0: 	package ifneeded t $i "set x $i"
sl@0:     }
sl@0:     list [catch {package require t 4.1} msg] $msg
sl@0: } {1 {can't find package t 4.1}}
sl@0: test pkg-2.8 {Tcl_PkgRequire procedure, can't find suitable version} !tip268 {
sl@0:     package forget t
sl@0:     package unknown {}
sl@0:     foreach i {1.4 3.4 2.3 2.4 2.2} {
sl@0: 	package ifneeded t $i "set x $i"
sl@0:     }
sl@0:     list [catch {package require -exact t 1.3} msg] $msg
sl@0: 
sl@0: } {1 {can't find package t 1.3}}
sl@0: test pkg-2.8-268 {Tcl_PkgRequire procedure, can't find suitable version} tip268 {
sl@0:     package forget t
sl@0:     package unknown {}
sl@0:     foreach i {1.4 3.4 2.3 2.4 2.2} {
sl@0: 	package ifneeded t $i "set x $i"
sl@0:     }
sl@0:     list [catch {package require -exact t 1.3} msg] $msg
sl@0: 
sl@0: } {1 {can't find package t 1.3-1.4}}
sl@0: test pkg-2.9 {Tcl_PkgRequire procedure, can't find suitable version} {
sl@0:     package forget t
sl@0:     package unknown {}
sl@0:     list [catch {package require t} msg] $msg
sl@0: } {1 {can't find package t}}
sl@0: test pkg-2.10 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
sl@0:     package forget t
sl@0:     package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"}
sl@0:     list [catch {package require t 2.1} msg] $msg $errorInfo
sl@0: } -match glob -result {1 {ifneeded test} {ifneeded test
sl@0:     while executing
sl@0: "error "ifneeded test""
sl@0:     ("package ifneeded*" script)
sl@0:     invoked from within
sl@0: "package require t 2.1"}}
sl@0: test pkg-2.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} -body {
sl@0:     package forget t
sl@0:     package ifneeded t 2.1 "set x invoked"
sl@0:     set x xxx
sl@0:     list [catch {package require t 2.1} msg] $msg $x
sl@0: } -match glob -result {1 * invoked}
sl@0: test pkg-2.12 {Tcl_PkgRequire procedure, self-deleting script} {
sl@0:     package forget t
sl@0:     package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2"
sl@0:     set x xxx
sl@0:     package require t 1.2
sl@0:     set x
sl@0: } {1.2}
sl@0: test pkg-2.13-!268 {Tcl_PkgRequire procedure, "package unknown" support} !tip268 {
sl@0:     proc pkgUnknown args {
sl@0: 	global x
sl@0: 	set x $args
sl@0: 	package provide [lindex $args 0] [lindex $args 1]
sl@0:     }
sl@0:     package forget t
sl@0:     foreach i {1.4 3.4 2.3 2.4 2.2} {
sl@0: 	package ifneeded t $i "set x $i"
sl@0:     }
sl@0:     package unknown pkgUnknown
sl@0:     set x xxx
sl@0:     package require -exact t 1.5
sl@0:     package unknown {}
sl@0:     set x
sl@0: } {t 1.5 -exact}
sl@0: 
sl@0: test pkg-2.13-268 {Tcl_PkgRequire procedure, "package unknown" support} tip268 {
sl@0:     proc pkgUnknown args {
sl@0: 	# args = name requirement
sl@0: 	# requirement = v-v (for exact version)
sl@0: 	global x
sl@0: 	set x $args
sl@0: 	package provide [lindex $args 0] [lindex [split [lindex $args 1] -] 0]
sl@0:     }
sl@0:     package forget t
sl@0:     foreach i {1.4 3.4 2.3 2.4 2.2} {
sl@0: 	package ifneeded t $i "set x $i"
sl@0:     }
sl@0:     package unknown pkgUnknown
sl@0:     set x xxx
sl@0:     package require -exact t 1.5
sl@0:     package unknown {}
sl@0:     set x
sl@0: } {t 1.5-1.6}
sl@0: 
sl@0: test pkg-2.14 {Tcl_PkgRequire procedure, "package unknown" support} {
sl@0:     proc pkgUnknown args {
sl@0: 	package ifneeded t 1.2 "set x loaded; package provide t 1.2"
sl@0:     }
sl@0:     package forget t
sl@0:     package unknown pkgUnknown
sl@0:     set x xxx
sl@0:     set result [list [package require t] $x]
sl@0:     package unknown {}
sl@0:     set result
sl@0: } {1.2 loaded}
sl@0: test pkg-2.15 {Tcl_PkgRequire procedure, "package unknown" support} !tip268 {
sl@0:     proc pkgUnknown args {
sl@0: 	global x
sl@0: 	set x $args
sl@0: 	package provide [lindex $args 0] 2.0
sl@0:     }
sl@0:     package forget {a b}
sl@0:     package unknown pkgUnknown
sl@0:     set x xxx
sl@0:     package require {a b}
sl@0:     package unknown {}
sl@0:     set x
sl@0: } {{a b} {}}
sl@0: test pkg-2.15-268 {Tcl_PkgRequire procedure, "package unknown" support} tip268 {
sl@0:     proc pkgUnknown args {
sl@0: 	global x
sl@0: 	set x $args
sl@0: 	package provide [lindex $args 0] 2.0
sl@0:     }
sl@0:     package forget {a b}
sl@0:     package unknown pkgUnknown
sl@0:     set x xxx
sl@0:     package require {a b}
sl@0:     package unknown {}
sl@0:     set x
sl@0: } {{a b} 0-}
sl@0: test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} !tip268 {
sl@0:     proc pkgUnknown args {
sl@0: 	error "testing package unknown"
sl@0:     }
sl@0:     package forget t 
sl@0:     package unknown pkgUnknown
sl@0:     set result [list [catch {package require t} msg] $msg $errorInfo]
sl@0:     package unknown {}
sl@0:     set result
sl@0: } {1 {testing package unknown} {testing package unknown
sl@0:     while executing
sl@0: "error "testing package unknown""
sl@0:     (procedure "pkgUnknown" line 2)
sl@0:     invoked from within
sl@0: "pkgUnknown t {}"
sl@0:     ("package unknown" script)
sl@0:     invoked from within
sl@0: "package require t"}}
sl@0: test pkg-2.16-268 {Tcl_PkgRequire procedure, "package unknown" error} tip268 {
sl@0:     proc pkgUnknown args {
sl@0: 	error "testing package unknown"
sl@0:     }
sl@0:     package forget t 
sl@0:     package unknown pkgUnknown
sl@0:     set result [list [catch {package require t} msg] $msg $errorInfo]
sl@0:     package unknown {}
sl@0:     set result
sl@0: } {1 {testing package unknown} {testing package unknown
sl@0:     while executing
sl@0: "error "testing package unknown""
sl@0:     (procedure "pkgUnknown" line 2)
sl@0:     invoked from within
sl@0: "pkgUnknown t 0-"
sl@0:     ("package unknown" script)
sl@0:     invoked from within
sl@0: "package require t"}}
sl@0: test pkg-2.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} !tip268 {
sl@0:     proc pkgUnknown args {
sl@0: 	global x
sl@0: 	set x $args
sl@0:     }
sl@0:     package forget t
sl@0:     foreach i {1.4 3.4 2.3 2.4 2.2} {
sl@0: 	package ifneeded t $i "set x $i"
sl@0:     }
sl@0:     package unknown pkgUnknown
sl@0:     set x xxx
sl@0:     set result [list [catch {package require -exact t 1.5} msg] $msg $x]
sl@0:     package unknown {}
sl@0:     set result
sl@0: } {1 {can't find package t 1.5} {t 1.5 -exact}}
sl@0: test pkg-2.17-268 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} tip268 {
sl@0:     proc pkgUnknown args {
sl@0: 	global x
sl@0: 	set x $args
sl@0:     }
sl@0:     package forget t
sl@0:     foreach i {1.4 3.4 2.3 2.4 2.2} {
sl@0: 	package ifneeded t $i "set x $i"
sl@0:     }
sl@0:     package unknown pkgUnknown
sl@0:     set x xxx
sl@0:     set result [list [catch {package require -exact t 1.5} msg] $msg $x]
sl@0:     package unknown {}
sl@0:     set result
sl@0: } {1 {can't find package t 1.5-1.6} {t 1.5-1.6}}
sl@0: test pkg-2.18 {Tcl_PkgRequire procedure, version checks} {
sl@0:     package forget t
sl@0:     package provide t 2.3
sl@0:     package require t
sl@0: } {2.3}
sl@0: test pkg-2.19 {Tcl_PkgRequire procedure, version checks} {
sl@0:     package forget t
sl@0:     package provide t 2.3
sl@0:     package require t 2.1
sl@0: } {2.3}
sl@0: test pkg-2.20 {Tcl_PkgRequire procedure, version checks} {
sl@0:     package forget t
sl@0:     package provide t 2.3
sl@0:     package require t 2.3
sl@0: } {2.3}
sl@0: test pkg-2.21 {Tcl_PkgRequire procedure, version checks} {
sl@0:     package forget t
sl@0:     package provide t 2.3
sl@0:     list [catch {package require t 2.4} msg] $msg
sl@0: } {1 {version conflict for package "t": have 2.3, need 2.4}}
sl@0: test pkg-2.22 {Tcl_PkgRequire procedure, version checks} {
sl@0:     package forget t
sl@0:     package provide t 2.3
sl@0:     list [catch {package require t 1.2} msg] $msg
sl@0: } {1 {version conflict for package "t": have 2.3, need 1.2}}
sl@0: test pkg-2.23 {Tcl_PkgRequire procedure, version checks} {
sl@0:     package forget t
sl@0:     package provide t 2.3
sl@0:     package require -exact t 2.3
sl@0: } {2.3}
sl@0: test pkg-2.24 {Tcl_PkgRequire procedure, version checks} !tip268 {
sl@0:     package forget t
sl@0:     package provide t 2.3
sl@0:     list [catch {package require -exact t 2.2} msg] $msg
sl@0: } {1 {version conflict for package "t": have 2.3, need 2.2}}
sl@0: test pkg-2.24-268 {Tcl_PkgRequire procedure, version checks} tip268 {
sl@0:     package forget t
sl@0:     package provide t 2.3
sl@0:     list [catch {package require -exact t 2.2} msg] $msg
sl@0: } {1 {version conflict for package "t": have 2.3, need 2.2-2.3}}
sl@0: test pkg-2.25 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
sl@0:     package forget t
sl@0:     package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test" EI}
sl@0:     list [catch {package require t 2.1} msg] $msg $errorInfo
sl@0: } -match glob -result {1 {ifneeded test} {EI
sl@0:     ("package ifneeded*" script)
sl@0:     invoked from within
sl@0: "package require t 2.1"}} -constraints knownBug
sl@0: test pkg-2.26 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
sl@0:     package forget t
sl@0:     package ifneeded t 2.1 {package provide t 2.1; foreach x 1 {error "ifneeded test" EI}}
sl@0:     list [catch {package require t 2.1} msg] $msg $errorInfo
sl@0: } -match glob -result {1 {ifneeded test} {EI
sl@0:     ("foreach" body line 1)
sl@0:     invoked from within
sl@0: "foreach x 1 {error "ifneeded test" EI}"
sl@0:     ("package ifneeded*" script)
sl@0:     invoked from within
sl@0: "package require t 2.1"}}
sl@0: test pkg-2.27 {Tcl_PkgRequire: circular dependency} -setup {
sl@0:     package forget foo
sl@0: } -body {
sl@0:     package ifneeded foo 1 {package require foo 1}
sl@0:     package require foo 1
sl@0: } -cleanup {
sl@0:     package forget foo
sl@0: } -returnCodes error -match glob -result {circular package dependency:*}
sl@0: test pkg-2.28 {Tcl_PkgRequire: circular dependency} -setup {
sl@0:     package forget foo
sl@0: } -body {
sl@0:     package ifneeded foo 1 {package require foo 2}
sl@0:     package require foo 1
sl@0: } -cleanup {
sl@0:     package forget foo
sl@0: } -returnCodes error -match glob -result {circular package dependency:*}
sl@0: test pkg-2.29 {Tcl_PkgRequire: circular dependency} -setup {
sl@0:     package forget foo
sl@0:     package forget bar
sl@0: } -body {
sl@0:     package ifneeded foo 1 {package require bar 1; package provide foo 1}
sl@0:     package ifneeded bar 1 {package require foo 1; package provide bar 1}
sl@0:     package require foo 1
sl@0: } -cleanup {
sl@0:     package forget foo
sl@0:     package forget bar
sl@0: } -returnCodes error -match glob -result {circular package dependency:*}
sl@0: test pkg-2.30 {Tcl_PkgRequire: circular dependency} -setup {
sl@0:     package forget foo
sl@0:     package forget bar
sl@0: } -body {
sl@0:     package ifneeded foo 1 {package require bar 1; package provide foo 1}
sl@0:     package ifneeded foo 2 {package provide foo 2}
sl@0:     package ifneeded bar 1 {package require foo 2; package provide bar 1}
sl@0:     package require foo 1
sl@0: } -cleanup {
sl@0:     package forget foo
sl@0:     package forget bar
sl@0: } -returnCodes error -match glob -result {circular package dependency:*}
sl@0: test pkg-2.31 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
sl@0:     package forget foo
sl@0: } -body {
sl@0:     package ifneeded foo 1 {package provide foo 1; error foo}
sl@0:     package require foo 1
sl@0: } -cleanup {
sl@0:     package forget foo
sl@0: } -returnCodes error -match glob -result foo
sl@0: test pkg-2.32 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
sl@0:     package forget foo
sl@0: } -body {
sl@0:     package ifneeded foo 1 {package provide foo 1; error foo}
sl@0:     catch {package require foo 1}
sl@0:     package provide foo
sl@0: } -cleanup {
sl@0:     package forget foo
sl@0: } -result {}
sl@0: test pkg-2.33 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
sl@0:     package forget foo
sl@0: } -body {
sl@0:     package ifneeded foo 1 {package provide foo 2}
sl@0:     package require foo 1
sl@0: } -cleanup {
sl@0:     package forget foo
sl@0: } -returnCodes error -match glob -result {attempt to provide package * failed:*}
sl@0: test pkg-2.34 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
sl@0:     package forget foo
sl@0: } -body {
sl@0:     package ifneeded foo 1 {package provide foo 1.1}
sl@0:     package require foo 1
sl@0: } -cleanup {
sl@0:     package forget foo
sl@0: } -result 1.1
sl@0: test pkg-2.34.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
sl@0:     package forget foo
sl@0: } -body {
sl@0:     package ifneeded foo 1.1 {package provide foo 1}
sl@0:     package require foo 1
sl@0: } -cleanup {
sl@0:     package forget foo
sl@0: } -result 1
sl@0: test pkg-2.34.2 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
sl@0:     package forget foo
sl@0: } -body {
sl@0:     package ifneeded foo 1.1 {package provide foo 1}
sl@0:     package require foo 1.1
sl@0: } -cleanup {
sl@0:     package forget foo
sl@0: } -returnCodes error -match glob -result {attempt to provide package * failed:*}
sl@0: test pkg-2.35 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
sl@0:     package forget foo
sl@0: } -body {
sl@0:     package ifneeded foo 1 {}
sl@0:     package require foo 1
sl@0: } -cleanup {
sl@0:     package forget foo
sl@0: } -returnCodes error -match glob -result {attempt to provide package * failed:*}
sl@0: test pkg-2.35.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
sl@0:     package forget foo
sl@0: } -body {
sl@0:     package ifneeded foo 1 {break}
sl@0:     package require foo 1
sl@0: } -cleanup {
sl@0:     package forget foo
sl@0: } -returnCodes error -match glob \
sl@0: -result {attempt to provide package * failed: bad return code:*}
sl@0: test pkg-2.36 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
sl@0:     package forget foo
sl@0: } -body {
sl@0:     package ifneeded foo 1 {continue}
sl@0:     package require foo 1
sl@0: } -cleanup {
sl@0:     package forget foo
sl@0: } -returnCodes error -match glob \
sl@0: -result {attempt to provide package * failed: bad return code:*}
sl@0: test pkg-2.37 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
sl@0:     package forget foo
sl@0: } -body {
sl@0:     package ifneeded foo 1 {return}
sl@0:     package require foo 1
sl@0: } -cleanup {
sl@0:     package forget foo
sl@0: } -returnCodes error -match glob \
sl@0: -result {attempt to provide package * failed: bad return code:*}
sl@0: test pkg-2.38 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
sl@0:     package forget foo
sl@0: } -body {
sl@0:     package ifneeded foo 1 {proc x {} {return -code 10}; x}
sl@0:     package require foo 1
sl@0: } -cleanup {
sl@0:     rename x {}
sl@0:     package forget foo
sl@0: } -returnCodes error -match glob \
sl@0: -result {attempt to provide package * failed: bad return code:*}
sl@0: test pkg-2.39 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
sl@0:     package forget foo
sl@0:     set saveUnknown [package unknown]
sl@0:     package unknown {package provide foo 2 ;#}
sl@0: } -body {
sl@0:     package require foo 1
sl@0: } -cleanup {
sl@0:     package forget foo
sl@0:     package unknown $saveUnknown
sl@0: } -returnCodes error -match glob -result *
sl@0: test pkg-2.40 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
sl@0:     package forget foo
sl@0:     set saveUnknown [package unknown]
sl@0:     package unknown {break ;#}
sl@0: } -body {
sl@0:     package require foo 1
sl@0: } -cleanup {
sl@0:     package forget foo
sl@0:     package unknown $saveUnknown
sl@0: } -returnCodes error -match glob -result {bad return code:*}
sl@0: test pkg-2.41 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
sl@0:     package forget foo
sl@0:     set saveUnknown [package unknown]
sl@0:     package unknown {continue ;#}
sl@0: } -body {
sl@0:     package require foo 1
sl@0: } -cleanup {
sl@0:     package forget foo
sl@0:     package unknown $saveUnknown
sl@0: } -returnCodes error -match glob -result {bad return code:*}
sl@0: test pkg-2.42 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
sl@0:     package forget foo
sl@0:     set saveUnknown [package unknown]
sl@0:     package unknown {return ;#}
sl@0: } -body {
sl@0:     package require foo 1
sl@0: } -cleanup {
sl@0:     package forget foo
sl@0:     package unknown $saveUnknown
sl@0: } -returnCodes error -match glob -result {bad return code:*}
sl@0: test pkg-2.43 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
sl@0:     package forget foo
sl@0:     set saveUnknown [package unknown]
sl@0:     proc x args {return -code 10}
sl@0:     package unknown x
sl@0: } -body {
sl@0:     package require foo 1
sl@0: } -cleanup {
sl@0:     rename x {}
sl@0:     package forget foo
sl@0:     package unknown $saveUnknown
sl@0: } -returnCodes error -match glob -result {bad return code:*}
sl@0: 
sl@0: 
sl@0: 
sl@0: test pkg-2.50 {Tcl_PkgRequire procedure, picking best stable version} tip268 {
sl@0:     package forget t
sl@0:     foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} {
sl@0: 	package ifneeded t $i "set x $i; package provide t $i"
sl@0:     }
sl@0:     set x xxx
sl@0:     package require t
sl@0:     set x
sl@0: } {3.4}
sl@0: 
sl@0: test pkg-2.51 {Tcl_PkgRequire procedure, picking best stable version} tip268 {
sl@0:     package forget t
sl@0:     foreach i {1.2b1 1.2 1.3a2 1.3} {
sl@0: 	package ifneeded t $i "set x $i; package provide t $i"
sl@0:     }
sl@0:     set x xxx
sl@0:     package require t
sl@0:     set x
sl@0: } {1.3}
sl@0: 
sl@0: test pkg-2.52 {Tcl_PkgRequire procedure, picking best stable version} tip268 {
sl@0:     package forget t
sl@0:     foreach i {1.2b1 1.2 1.3 1.3a2} {
sl@0: 	package ifneeded t $i "set x $i; package provide t $i"
sl@0:     }
sl@0:     set x xxx
sl@0:     package require t
sl@0:     set x
sl@0: } {1.3}
sl@0: 
sl@0: 
sl@0: 
sl@0: test pkg-3.1 {Tcl_PackageCmd procedure} {
sl@0:     list [catch {package} msg] $msg
sl@0: } {1 {wrong # args: should be "package option ?arg arg ...?"}}
sl@0: test pkg-3.2 {Tcl_PackageCmd procedure, "forget" option} {
sl@0:     foreach i [package names] {
sl@0: 	package forget $i
sl@0:     }
sl@0:     package names
sl@0: } {}
sl@0: test pkg-3.3 {Tcl_PackageCmd procedure, "forget" option} {
sl@0:     foreach i [package names] {
sl@0: 	package forget $i
sl@0:     }
sl@0:     package forget foo
sl@0: } {}
sl@0: test pkg-3.4 {Tcl_PackageCmd procedure, "forget" option} {
sl@0:     foreach i [package names] {
sl@0: 	package forget $i
sl@0:     }
sl@0:     package ifneeded t 1.1 {first script}
sl@0:     package ifneeded t 2.3 {second script}
sl@0:     package ifneeded x 1.4 {x's script}
sl@0:     set result {}
sl@0:     lappend result [lsort [package names]] [package versions t]
sl@0:     package forget t
sl@0:     lappend result [lsort [package names]] [package versions t]
sl@0: } {{t x} {1.1 2.3} x {}}
sl@0: test pkg-3.5 {Tcl_PackageCmd procedure, "forget" option} {
sl@0:     foreach i [package names] {
sl@0: 	package forget $i
sl@0:     }
sl@0:     package ifneeded a 1.1 {first script}
sl@0:     package ifneeded b 2.3 {second script}
sl@0:     package ifneeded c 1.4 {third script}
sl@0:     package forget
sl@0:     set result [list [lsort [package names]]]
sl@0:     package forget a c
sl@0:     lappend result [lsort [package names]]
sl@0: } {{a b c} b}
sl@0: test pkg-3.5.1 {Tcl_PackageCmd procedure, "forget" option} {
sl@0:     # Test for Bug 415273
sl@0:     package ifneeded a 1 "I should have been forgotten"
sl@0:     package forget no-such-package a
sl@0:     set x [package ifneeded a 1]
sl@0:     package forget a
sl@0:     set x
sl@0: } {}
sl@0: test pkg-3.6 {Tcl_PackageCmd procedure, "ifneeded" option} {
sl@0:     list [catch {package ifneeded a} msg] $msg
sl@0: } {1 {wrong # args: should be "package ifneeded package version ?script?"}}
sl@0: test pkg-3.7 {Tcl_PackageCmd procedure, "ifneeded" option} {
sl@0:     list [catch {package ifneeded a b c d} msg] $msg
sl@0: } {1 {wrong # args: should be "package ifneeded package version ?script?"}}
sl@0: test pkg-3.8 {Tcl_PackageCmd procedure, "ifneeded" option} {
sl@0:     list [catch {package ifneeded t xyz} msg] $msg
sl@0: } {1 {expected version number but got "xyz"}}
sl@0: test pkg-3.9 {Tcl_PackageCmd procedure, "ifneeded" option} {
sl@0:     foreach i [package names] {
sl@0: 	package forget $i
sl@0:     }
sl@0:     list [package ifneeded foo 1.1] [package names]
sl@0: } {{} {}}
sl@0: test pkg-3.10 {Tcl_PackageCmd procedure, "ifneeded" option} {
sl@0:     package forget t
sl@0:     package ifneeded t 1.4 "script for t 1.4"
sl@0:     list [package names] [package ifneeded t 1.4] [package versions t]
sl@0: } {t {script for t 1.4} 1.4}
sl@0: test pkg-3.11 {Tcl_PackageCmd procedure, "ifneeded" option} {
sl@0:     package forget t
sl@0:     package ifneeded t 1.4 "script for t 1.4"
sl@0:     list [package ifneeded t 1.5] [package names] [package versions t]
sl@0: } {{} t 1.4}
sl@0: test pkg-3.12 {Tcl_PackageCmd procedure, "ifneeded" option} {
sl@0:     package forget t
sl@0:     package ifneeded t 1.4 "script for t 1.4"
sl@0:     package ifneeded t 1.4 "second script for t 1.4"
sl@0:     list [package ifneeded t 1.4] [package names] [package versions t]
sl@0: } {{second script for t 1.4} t 1.4}
sl@0: test pkg-3.13 {Tcl_PackageCmd procedure, "ifneeded" option} {
sl@0:     package forget t
sl@0:     package ifneeded t 1.4 "script for t 1.4"
sl@0:     package ifneeded t 1.2 "second script"
sl@0:     package ifneeded t 3.1 "last script"
sl@0:     list [package ifneeded t 1.2] [package versions t]
sl@0: } {{second script} {1.4 1.2 3.1}}
sl@0: test pkg-3.14 {Tcl_PackageCmd procedure, "names" option} {
sl@0:     list [catch {package names a} msg] $msg
sl@0: } {1 {wrong # args: should be "package names"}}
sl@0: test pkg-3.15 {Tcl_PackageCmd procedure, "names" option} {
sl@0:     foreach i [package names] {
sl@0: 	package forget $i
sl@0:     }
sl@0:     package names
sl@0: } {}
sl@0: test pkg-3.16 {Tcl_PackageCmd procedure, "names" option} {
sl@0:     foreach i [package names] {
sl@0: 	package forget $i
sl@0:     }
sl@0:     package ifneeded x 1.2 {dummy}
sl@0:     package provide x 1.3
sl@0:     package provide y 2.4
sl@0:     catch {package require z 47.16}
sl@0:     lsort [package names]
sl@0: } {x y}
sl@0: test pkg-3.17 {Tcl_PackageCmd procedure, "provide" option} {
sl@0:     list [catch {package provide} msg] $msg
sl@0: } {1 {wrong # args: should be "package provide package ?version?"}}
sl@0: test pkg-3.18 {Tcl_PackageCmd procedure, "provide" option} {
sl@0:     list [catch {package provide a b c} msg] $msg
sl@0: } {1 {wrong # args: should be "package provide package ?version?"}}
sl@0: test pkg-3.19 {Tcl_PackageCmd procedure, "provide" option} {
sl@0:     package forget t
sl@0:     package provide t
sl@0: } {}
sl@0: test pkg-3.20 {Tcl_PackageCmd procedure, "provide" option} {
sl@0:     package forget t
sl@0:     package provide t 2.3
sl@0:     package provide t
sl@0: } {2.3}
sl@0: test pkg-3.21 {Tcl_PackageCmd procedure, "provide" option} {
sl@0:     package forget t
sl@0:     list [catch {package provide t a.b} msg] $msg
sl@0: } {1 {expected version number but got "a.b"}}
sl@0: test pkg-3.22 {Tcl_PackageCmd procedure, "require" option} !tip268 {
sl@0:     list [catch {package require} msg] $msg
sl@0: } {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
sl@0: test pkg-3.22-268 {Tcl_PackageCmd procedure, "require" option} tip268 {
sl@0:     list [catch {package require} msg] $msg
sl@0: } {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}
sl@0: test pkg-3.23 {Tcl_PackageCmd procedure, "require" option} !tip268 {
sl@0:     list [catch {package require a b c} msg] $msg
sl@0: } {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
sl@0: test pkg-3.24 {Tcl_PackageCmd procedure, "require" option} !tip268 {
sl@0:     list [catch {package require -exact a b c} msg] $msg
sl@0: } {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
sl@0: test pkg-3.24-268 {Tcl_PackageCmd procedure, "require" option} tip268 {
sl@0:     list [catch {package require -exact a b c} msg] $msg
sl@0:     # Exact syntax: -exact name version
sl@0:     #              name ?requirement...?
sl@0: } {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}
sl@0: test pkg-3.25 {Tcl_PackageCmd procedure, "require" option} !tip268 {
sl@0:     list [catch {package require -bs a b} msg] $msg
sl@0: } {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
sl@0: test pkg-3.26 {Tcl_PackageCmd procedure, "require" option} {
sl@0:     list [catch {package require x a.b} msg] $msg
sl@0: } {1 {expected version number but got "a.b"}}
sl@0: test pkg-3.27 {Tcl_PackageCmd procedure, "require" option} {
sl@0:     list [catch {package require -exact x a.b} msg] $msg
sl@0: } {1 {expected version number but got "a.b"}}
sl@0: test pkg-3.28 {Tcl_PackageCmd procedure, "require" option} !tip268 {
sl@0:     list [catch {package require -exact x} msg] $msg
sl@0: } {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
sl@0: test pkg-3.28-268 {Tcl_PackageCmd procedure, "require" option} tip268 {
sl@0:     list [catch {package require -exact x} msg] $msg
sl@0: } {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}
sl@0: test pkg-3.29 {Tcl_PackageCmd procedure, "require" option} !tip268 {
sl@0:     list [catch {package require -exact} msg] $msg
sl@0: } {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
sl@0: test pkg-3.29-268 {Tcl_PackageCmd procedure, "require" option} tip268 {
sl@0:     list [catch {package require -exact} msg] $msg
sl@0: } {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}
sl@0: test pkg-3.30 {Tcl_PackageCmd procedure, "require" option} {
sl@0:     package forget t
sl@0:     package provide t 2.3
sl@0:     package require t 2.1
sl@0: } {2.3}
sl@0: test pkg-3.31 {Tcl_PackageCmd procedure, "require" option} {
sl@0:     package forget t
sl@0:     list [catch {package require t} msg] $msg
sl@0: } {1 {can't find package t}}
sl@0: test pkg-3.32 {Tcl_PackageCmd procedure, "require" option} {
sl@0:     package forget t
sl@0:     package ifneeded t 2.3 "error {synthetic error}"
sl@0:     list [catch {package require t 2.3} msg] $msg
sl@0: } {1 {synthetic error}}
sl@0: test pkg-3.33 {Tcl_PackageCmd procedure, "unknown" option} {
sl@0:     list [catch {package unknown a b} msg] $msg
sl@0: } {1 {wrong # args: should be "package unknown ?command?"}}
sl@0: test pkg-3.34 {Tcl_PackageCmd procedure, "unknown" option} {
sl@0:     package unknown "test script"
sl@0:     package unknown
sl@0: } {test script}
sl@0: test pkg-3.35 {Tcl_PackageCmd procedure, "unknown" option} {
sl@0:     package unknown "test script"
sl@0:     package unknown {}
sl@0:     package unknown
sl@0: } {}
sl@0: test pkg-3.36 {Tcl_PackageCmd procedure, "vcompare" option} {
sl@0:     list [catch {package vcompare a} msg] $msg
sl@0: } {1 {wrong # args: should be "package vcompare version1 version2"}}
sl@0: test pkg-3.37 {Tcl_PackageCmd procedure, "vcompare" option} {
sl@0:     list [catch {package vcompare a b c} msg] $msg
sl@0: } {1 {wrong # args: should be "package vcompare version1 version2"}}
sl@0: test pkg-3.38 {Tcl_PackageCmd procedure, "vcompare" option} {
sl@0:     list [catch {package vcompare x.y 3.4} msg] $msg
sl@0: } {1 {expected version number but got "x.y"}}
sl@0: test pkg-3.39 {Tcl_PackageCmd procedure, "vcompare" option} {
sl@0:     list [catch {package vcompare 2.1 a.b} msg] $msg
sl@0: } {1 {expected version number but got "a.b"}}
sl@0: test pkg-3.40 {Tcl_PackageCmd procedure, "vcompare" option} {
sl@0:     package vc 2.1 2.3
sl@0: } {-1}
sl@0: test pkg-3.41 {Tcl_PackageCmd procedure, "vcompare" option} {
sl@0:     package vc 2.2.4 2.2.4
sl@0: } {0}
sl@0: test pkg-3.42 {Tcl_PackageCmd procedure, "versions" option} {
sl@0:     list [catch {package versions} msg] $msg
sl@0: } {1 {wrong # args: should be "package versions package"}}
sl@0: test pkg-3.43 {Tcl_PackageCmd procedure, "versions" option} {
sl@0:     list [catch {package versions a b} msg] $msg
sl@0: } {1 {wrong # args: should be "package versions package"}}
sl@0: test pkg-3.44 {Tcl_PackageCmd procedure, "versions" option} {
sl@0:     package forget t
sl@0:     package versions t
sl@0: } {}
sl@0: test pkg-3.45 {Tcl_PackageCmd procedure, "versions" option} {
sl@0:     package forget t
sl@0:     package provide t 2.3
sl@0:     package versions t
sl@0: } {}
sl@0: test pkg-3.46 {Tcl_PackageCmd procedure, "versions" option} {
sl@0:     package forget t
sl@0:     package ifneeded t 2.3 x
sl@0:     package ifneeded t 2.4 y
sl@0:     package versions t
sl@0: } {2.3 2.4}
sl@0: test pkg-3.47 {Tcl_PackageCmd procedure, "vsatisfies" option} !tip268 {
sl@0:     list [catch {package vsatisfies a} msg] $msg
sl@0: } {1 {wrong # args: should be "package vsatisfies version1 version2"}}
sl@0: test pkg-3.47-268 {Tcl_PackageCmd procedure, "vsatisfies" option} tip268 {
sl@0:     list [catch {package vsatisfies a} msg] $msg
sl@0: } {1 {wrong # args: should be "package vsatisfies version requirement requirement..."}}
sl@0: test pkg-3.48 {Tcl_PackageCmd procedure, "vsatisfies" option} !tip268 {
sl@0:     list [catch {package vsatisfies a b c} msg] $msg
sl@0: } {1 {wrong # args: should be "package vsatisfies version1 version2"}}
sl@0: test pkg-3.49 {Tcl_PackageCmd procedure, "vsatisfies" option} {
sl@0:     list [catch {package vsatisfies x.y 3.4} msg] $msg
sl@0: } {1 {expected version number but got "x.y"}}
sl@0: test pkg-3.50 {Tcl_PackageCmd procedure, "vsatisfies" option} {
sl@0:     list [catch {package vcompare 2.1 a.b} msg] $msg
sl@0: } {1 {expected version number but got "a.b"}}
sl@0: test pkg-3.51 {Tcl_PackageCmd procedure, "vsatisfies" option} {
sl@0:     package vs 2.3 2.1
sl@0: } {1}
sl@0: test pkg-3.52 {Tcl_PackageCmd procedure, "vsatisfies" option} {
sl@0:     package vs 2.3 1.2
sl@0: } {0}
sl@0: test pkg-3.53 {Tcl_PackageCmd procedure, "versions" option} !tip268 {
sl@0:     list [catch {package foo} msg] $msg
sl@0: } {1 {bad option "foo": must be forget, ifneeded, names, present, provide, require, unknown, vcompare, versions, or vsatisfies}}
sl@0: test pkg-3.53-268 {Tcl_PackageCmd procedure, "versions" option} tip268 {
sl@0:     list [catch {package foo} msg] $msg
sl@0: } {1 {bad option "foo": must be forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies}}
sl@0: 
sl@0: test pkg-3.54 {Tcl_PackageCmd procedure, "vsatisfies" option} tip268 {
sl@0:     list [catch {package vsatisfies 2.1 2.1-3.2-4.5} msg] $msg
sl@0: } {1 {expected versionMin-versionMax but got "2.1-3.2-4.5"}}
sl@0: 
sl@0: test pkg-3.55 {Tcl_PackageCmd procedure, "vsatisfies" option} tip268 {
sl@0:     list [catch {package vsatisfies 2.1 3.2-x.y} msg] $msg
sl@0: } {1 {expected version number but got "x.y"}}
sl@0: 
sl@0: test pkg-3.56 {Tcl_PackageCmd procedure, "vsatisfies" option} tip268 {
sl@0:     list [catch {package vsatisfies 2.1 x.y-3.2} msg] $msg
sl@0: } {1 {expected version number but got "x.y"}}
sl@0: 
sl@0: # No tests for FindPackage;  can't think up anything detectable
sl@0: # errors.
sl@0: 
sl@0: test pkg-4.1 {TclFreePackageInfo procedure} {
sl@0:     interp create foo
sl@0:     foo eval {
sl@0: 	package ifneeded t 2.3 x
sl@0: 	package ifneeded t 2.4 y
sl@0: 	package ifneeded x 3.1 z
sl@0: 	package provide q 4.3
sl@0: 	package unknown "will this get freed?"
sl@0:     }
sl@0:     interp delete foo
sl@0: } {}
sl@0: test pkg-4.2 {TclFreePackageInfo procedure} -body {
sl@0:     interp create foo
sl@0:     foo eval {
sl@0: 	package ifneeded t 2.3 x
sl@0: 	package ifneeded t 2.4 y
sl@0: 	package ifneeded x 3.1 z
sl@0: 	package provide q 4.3
sl@0:     }
sl@0:     foo alias z kill
sl@0:     proc kill {} {
sl@0: 	interp delete foo
sl@0:     }
sl@0:     foo eval package require x 3.1
sl@0: } -returnCodes error -match glob -result *
sl@0: 
sl@0: test pkg-5.1 {CheckVersion procedure} {
sl@0:     list [catch {package vcompare 1 2.1} msg] $msg
sl@0: } {0 -1}
sl@0: test pkg-5.2 {CheckVersion procedure} {
sl@0:     list [catch {package vcompare .1 2.1} msg] $msg
sl@0: } {1 {expected version number but got ".1"}}
sl@0: test pkg-5.3 {CheckVersion procedure} {
sl@0:     list [catch {package vcompare 111.2a.3 2.1} msg] $msg
sl@0: } {1 {expected version number but got "111.2a.3"}}
sl@0: test pkg-5.4 {CheckVersion procedure} {
sl@0:     list [catch {package vcompare 1.2.3. 2.1} msg] $msg
sl@0: } {1 {expected version number but got "1.2.3."}}
sl@0: test pkg-5.5 {CheckVersion procedure} {
sl@0:     list [catch {package vcompare 1.2..3 2.1} msg] $msg
sl@0: } {1 {expected version number but got "1.2..3"}}
sl@0: 
sl@0: test pkg-6.1 {ComparePkgVersions procedure} {
sl@0:     package vcompare 1.23 1.22
sl@0: } {1}
sl@0: test pkg-6.2 {ComparePkgVersions procedure} {
sl@0:     package vcompare 1.22.1.2.3 1.22.1.2.3
sl@0: } {0}
sl@0: test pkg-6.3 {ComparePkgVersions procedure} {
sl@0:     package vcompare 1.21 1.22
sl@0: } {-1}
sl@0: test pkg-6.4 {ComparePkgVersions procedure} {
sl@0:     package vcompare 1.21 1.21.2
sl@0: } {-1}
sl@0: test pkg-6.5 {ComparePkgVersions procedure} {
sl@0:     package vcompare 1.21.1 1.21
sl@0: } {1}
sl@0: test pkg-6.6 {ComparePkgVersions procedure} {
sl@0:     package vsatisfies 1.21.1 1.21
sl@0: } {1}
sl@0: test pkg-6.7 {ComparePkgVersions procedure} {
sl@0:     package vsatisfies 2.22.3 1.21
sl@0: } {0}
sl@0: test pkg-6.8 {ComparePkgVersions procedure} {
sl@0:     package vsatisfies 1 1
sl@0: } {1}
sl@0: test pkg-6.9 {ComparePkgVersions procedure} {
sl@0:     package vsatisfies 2 1
sl@0: } {0}
sl@0: 
sl@0: test pkg-7.1 {Tcl_PkgPresent procedure, any version} {
sl@0:     package forget t
sl@0:     package provide t 2.4
sl@0:     package present t
sl@0: } {2.4}
sl@0: test pkg-7.2 {Tcl_PkgPresent procedure, correct version} {
sl@0:     package forget t
sl@0:     package provide t 2.4
sl@0:     package present t 2.4
sl@0: } {2.4}
sl@0: test pkg-7.3 {Tcl_PkgPresent procedure, satisfying version} {
sl@0:     package forget t
sl@0:     package provide t 2.4
sl@0:     package present t 2.0
sl@0: } {2.4}
sl@0: test pkg-7.4 {Tcl_PkgPresent procedure, not satisfying version} {
sl@0:     package forget t
sl@0:     package provide t 2.4
sl@0:     list [catch {package present t 2.6} msg] $msg
sl@0: } {1 {version conflict for package "t": have 2.4, need 2.6}}
sl@0: test pkg-7.5 {Tcl_PkgPresent procedure, not satisfying version} {
sl@0:     package forget t
sl@0:     package provide t 2.4
sl@0:     list [catch {package present t 1.0} msg] $msg
sl@0: } {1 {version conflict for package "t": have 2.4, need 1.0}}
sl@0: test pkg-7.6 {Tcl_PkgPresent procedure, exact version} {
sl@0:     package forget t
sl@0:     package provide t 2.4
sl@0:     package present -exact t 2.4
sl@0: } {2.4}
sl@0: test pkg-7.7 {Tcl_PkgPresent procedure, not exact version} {
sl@0:     package forget t
sl@0:     package provide t 2.4
sl@0:     list [catch {package present -exact t 2.3} msg] $msg
sl@0: } {1 {version conflict for package "t": have 2.4, need 2.3}}
sl@0: test pkg-7.8 {Tcl_PkgPresent procedure, unknown package} {
sl@0:     package forget t
sl@0:     list [catch {package present t} msg] $msg
sl@0: } {1 {package t is not present}}
sl@0: test pkg-7.9 {Tcl_PkgPresent procedure, unknown package} {
sl@0:     package forget t
sl@0:     list [catch {package present t 2.4} msg] $msg
sl@0: } {1 {package t 2.4 is not present}}
sl@0: test pkg-7.10 {Tcl_PkgPresent procedure, unknown package} {
sl@0:     package forget t
sl@0:     list [catch {package present -exact t 2.4} msg] $msg
sl@0: } {1 {package t 2.4 is not present}}
sl@0: test pkg-7.11 {Tcl_PackageCmd procedure, "present" option} {
sl@0:     list [catch {package present} msg] $msg
sl@0: } {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
sl@0: test pkg-7.12 {Tcl_PackageCmd procedure, "present" option} {
sl@0:     list [catch {package present a b c} msg] $msg
sl@0: } {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
sl@0: test pkg-7.13 {Tcl_PackageCmd procedure, "present" option} {
sl@0:     list [catch {package present -exact a b c} msg] $msg
sl@0: } {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
sl@0: test pkg-7.14 {Tcl_PackageCmd procedure, "present" option} {
sl@0:     list [catch {package present -bs a b} msg] $msg
sl@0: } {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
sl@0: test pkg-7.15 {Tcl_PackageCmd procedure, "present" option} {
sl@0:     list [catch {package present x a.b} msg] $msg
sl@0: } {1 {expected version number but got "a.b"}}
sl@0: test pkg-7.16 {Tcl_PackageCmd procedure, "present" option} {
sl@0:     list [catch {package present -exact x a.b} msg] $msg
sl@0: } {1 {expected version number but got "a.b"}}
sl@0: test pkg-7.17 {Tcl_PackageCmd procedure, "present" option} {
sl@0:     list [catch {package present -exact x} msg] $msg
sl@0: } {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
sl@0: test pkg-7.18 {Tcl_PackageCmd procedure, "present" option} {
sl@0:     list [catch {package present -exact} msg] $msg
sl@0: } {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
sl@0: 
sl@0: 
sl@0: # Note: It is correct that the result of the very first test,
sl@0: # i.e. "5.0 5.0a0" is 1, i.e. that version 5.0a0 satisfies a 5.0
sl@0: # requirement.
sl@0: 
sl@0: # The requirement "5.0" internally translates first to "5.0-6", and
sl@0: # then to its final form of "5.0a0-6a0". These translations are
sl@0: # explicitly specified by the TIP (Search for "padded/extended
sl@0: # internally with 'a0'"). This was done intentionally for exactly the
sl@0: # tested case, that an alpha package can satisfy a requirement for the
sl@0: # regular package. An example would be a package FOO requiring Tcl 8.X
sl@0: # for its operation. It can be used with Tcl 8.Xa0. Without our
sl@0: # translation that would not be possible.
sl@0: 
sl@0: set n 0
sl@0: foreach {r p vs vc} {
sl@0:     5.0 5.0a0 1 1
sl@0:     5.0a0 5.0 1 -1
sl@0: 
sl@0:     8.5a0    8.5a5    1          -1
sl@0:     8.5a0    8.5b1    1          -1
sl@0:     8.5a0    8.5.1    1          -1
sl@0:     8.5a0    8.6a0    1          -1
sl@0:     8.5a0    8.6b0    1          -1
sl@0:     8.5a0    8.6.0    1          -1
sl@0:     8.5a6    8.5a5    0          1
sl@0:     8.5a6    8.5b1    1          -1
sl@0:     8.5a6    8.5.1    1          -1
sl@0:     8.5a6    8.6a0    1          -1
sl@0:     8.5a6    8.6b0    1          -1
sl@0:     8.5a6    8.6.0    1          -1
sl@0:     8.5b0    8.5a5    0          1
sl@0:     8.5b0    8.5b1    1          -1
sl@0:     8.5b0    8.5.1    1          -1
sl@0:     8.5b0    8.6a0    1          -1
sl@0:     8.5b0    8.6b0    1          -1
sl@0:     8.5b0    8.6.0    1          -1
sl@0:     8.5b2    8.5a5    0          1
sl@0:     8.5b2    8.5b1    0          1
sl@0:     8.5b2    8.5.1    1          -1
sl@0:     8.5b2    8.6a0    1          -1
sl@0:     8.5b2    8.6b0    1          -1
sl@0:     8.5b2    8.6.0    1          -1
sl@0:     8.5      8.5a5    1          1
sl@0:     8.5      8.5b1    1          1
sl@0:     8.5      8.5.1    1          -1
sl@0:     8.5      8.6a0    1          -1
sl@0:     8.5      8.6b0    1          -1
sl@0:     8.5      8.6.0    1          -1
sl@0:     8.5.0    8.5a5    0          1
sl@0:     8.5.0    8.5b1    0          1
sl@0:     8.5.0    8.5.1    1          -1
sl@0:     8.5.0    8.6a0    1          -1
sl@0:     8.5.0    8.6b0    1          -1
sl@0:     8.5.0    8.6.0    1          -1
sl@0: } {
sl@0:     test package-vsatisfies-1.$n {package vsatisfies} tip268 {
sl@0: 	package vsatisfies $p $r
sl@0:     } $vs
sl@0: 
sl@0:     test package-vcompare-1.$n {package vcompare} tip268 {
sl@0: 	package vcompare $r $p
sl@0:     } $vc
sl@0: 
sl@0:     incr n
sl@0: }
sl@0: 
sl@0: set n 0
sl@0: foreach {required provided satisfied} {
sl@0:     8.5a0-   8.5a5    1
sl@0:     8.5a0-   8.5b1    1
sl@0:     8.5a0-   8.5.1    1
sl@0:     8.5a0-   8.6a0    1
sl@0:     8.5a0-   8.6b0    1
sl@0:     8.5a0-   8.6.0    1
sl@0:     8.5a6-   8.5a5    0
sl@0:     8.5a6-   8.5b1    1
sl@0:     8.5a6-   8.5.1    1
sl@0:     8.5a6-   8.6a0    1
sl@0:     8.5a6-   8.6b0    1
sl@0:     8.5a6-   8.6.0    1
sl@0:     8.5b0-   8.5a5    0
sl@0:     8.5b0-   8.5b1    1
sl@0:     8.5b0-   8.5.1    1
sl@0:     8.5b0-   8.6a0    1
sl@0:     8.5b0-   8.6b0    1
sl@0:     8.5b0-   8.6.0    1
sl@0:     8.5b2-   8.5a5    0
sl@0:     8.5b2-   8.5b1    0
sl@0:     8.5b2-   8.5.1    1
sl@0:     8.5b2-   8.6a0    1
sl@0:     8.5b2-   8.6b0    1
sl@0:     8.5b2-   8.6.0    1
sl@0:     8.5-     8.5a5    1
sl@0:     8.5-     8.5b1    1
sl@0:     8.5-     8.5.1    1
sl@0:     8.5-     8.6a0    1
sl@0:     8.5-     8.6b0    1
sl@0:     8.5-     8.6.0    1
sl@0:     8.5.0-   8.5a5    0
sl@0:     8.5.0-   8.5b1    0
sl@0:     8.5.0-   8.5.1    1
sl@0:     8.5.0-   8.6a0    1
sl@0:     8.5.0-   8.6b0    1
sl@0:     8.5.0-   8.6.0    1
sl@0:     8.5a0-7  8.5a5    0
sl@0:     8.5a0-7  8.5b1    0
sl@0:     8.5a0-7  8.5.1    0
sl@0:     8.5a0-7  8.6a0    0
sl@0:     8.5a0-7  8.6b0    0
sl@0:     8.5a0-7  8.6.0    0
sl@0:     8.5a6-7  8.5a5    0
sl@0:     8.5a6-7  8.5b1    0
sl@0:     8.5a6-7  8.5.1    0
sl@0:     8.5a6-7  8.6a0    0
sl@0:     8.5a6-7  8.6b0    0
sl@0:     8.5a6-7  8.6.0    0
sl@0:     8.5b0-7  8.5a5    0
sl@0:     8.5b0-7  8.5b1    0
sl@0:     8.5b0-7  8.5.1    0
sl@0:     8.5b0-7  8.6a0    0
sl@0:     8.5b0-7  8.6b0    0
sl@0:     8.5b0-7  8.6.0    0
sl@0:     8.5b2-7  8.5a5    0
sl@0:     8.5b2-7  8.5b1    0
sl@0:     8.5b2-7  8.5.1    0
sl@0:     8.5b2-7  8.6a0    0
sl@0:     8.5b2-7  8.6b0    0
sl@0:     8.5b2-7  8.6.0    0
sl@0:     8.5-7    8.5a5    0
sl@0:     8.5-7    8.5b1    0
sl@0:     8.5-7    8.5.1    0
sl@0:     8.5-7    8.6a0    0
sl@0:     8.5-7    8.6b0    0
sl@0:     8.5-7    8.6.0    0
sl@0:     8.5.0-7  8.5a5    0
sl@0:     8.5.0-7  8.5b1    0
sl@0:     8.5.0-7  8.5.1    0
sl@0:     8.5.0-7  8.6a0    0
sl@0:     8.5.0-7  8.6b0    0
sl@0:     8.5.0-7  8.6.0    0
sl@0:     8.5a0-8.6.1 8.5a5    1
sl@0:     8.5a0-8.6.1 8.5b1    1
sl@0:     8.5a0-8.6.1 8.5.1    1
sl@0:     8.5a0-8.6.1 8.6a0    1
sl@0:     8.5a0-8.6.1 8.6b0    1
sl@0:     8.5a0-8.6.1 8.6.0    1
sl@0:     8.5a6-8.6.1 8.5a5    0
sl@0:     8.5a6-8.6.1 8.5b1    1
sl@0:     8.5a6-8.6.1 8.5.1    1
sl@0:     8.5a6-8.6.1 8.6a0    1
sl@0:     8.5a6-8.6.1 8.6b0    1
sl@0:     8.5a6-8.6.1 8.6.0    1
sl@0:     8.5b0-8.6.1 8.5a5    0
sl@0:     8.5b0-8.6.1 8.5b1    1
sl@0:     8.5b0-8.6.1 8.5.1    1
sl@0:     8.5b0-8.6.1 8.6a0    1
sl@0:     8.5b0-8.6.1 8.6b0    1
sl@0:     8.5b0-8.6.1 8.6.0    1
sl@0:     8.5b2-8.6.1 8.5a5    0
sl@0:     8.5b2-8.6.1 8.5b1    0
sl@0:     8.5b2-8.6.1 8.5.1    1
sl@0:     8.5b2-8.6.1 8.6a0    1
sl@0:     8.5b2-8.6.1 8.6b0    1
sl@0:     8.5b2-8.6.1 8.6.0    1
sl@0:     8.5-8.6.1 8.5a5    1
sl@0:     8.5-8.6.1 8.5b1    1
sl@0:     8.5-8.6.1 8.5.1    1
sl@0:     8.5-8.6.1 8.6a0    1
sl@0:     8.5-8.6.1 8.6b0    1
sl@0:     8.5-8.6.1 8.6.0    1
sl@0:     8.5.0-8.6.1 8.5a5    0
sl@0:     8.5.0-8.6.1 8.5b1    0
sl@0:     8.5.0-8.6.1 8.5.1    1
sl@0:     8.5.0-8.6.1 8.6a0    1
sl@0:     8.5.0-8.6.1 8.6b0    1
sl@0:     8.5.0-8.6.1 8.6.0    1
sl@0:     8.5a0-8.5a0 8.5a0    1
sl@0:     8.5a0-8.5a0 8.5b1    0
sl@0:     8.5a0-8.5a0 8.4      0
sl@0:     8.5b0-8.5b0 8.5a5    0
sl@0:     8.5b0-8.5b0 8.5b0    1
sl@0:     8.5b0-8.5b0 8.5.1    0
sl@0:     8.5-8.5  8.5a5    0
sl@0:     8.5-8.5  8.5b1    0
sl@0:     8.5-8.5  8.5      1
sl@0:     8.5-8.5  8.5.1    0
sl@0:     8.5.0-8.5.0 8.5a5    0
sl@0:     8.5.0-8.5.0 8.5b1    0
sl@0:     8.5.0-8.5.0 8.5.0    1
sl@0:     8.5.0-8.5.0 8.5.1    0
sl@0:     8.5.0-8.5.0 8.6a0    0
sl@0:     8.5.0-8.5.0 8.6b0    0
sl@0:     8.5.0-8.5.0 8.6.0    0
sl@0:     8.2      9        0
sl@0:     8.2-     9        1
sl@0:     8.2-8.5  9        0
sl@0:     8.2-9.1  9        1
sl@0: 
sl@0:     8.5-8.5     8.5b1 0
sl@0:     8.5a0-8.5   8.5b1 0
sl@0:     8.5a0-8.5.1 8.5b1 1
sl@0: 
sl@0:     8.5-8.5     8.5 1
sl@0:     8.5.0-8.5.0 8.5 1
sl@0:     8.5a0-8.5.0 8.5 0
sl@0: 
sl@0: } {
sl@0:     test package-vsatisfies-2.$n "package vsatisfies $provided $required" tip268 {
sl@0: 	package vsatisfies $provided $required
sl@0:     } $satisfied
sl@0:     incr n
sl@0: }
sl@0: 
sl@0: test package-vsatisfies-3.0 "package vsatisfies multiple" tip268 {
sl@0:     #                      yes no
sl@0:     package vsatisfies 8.4 8.4 7.3
sl@0: } 1
sl@0: 
sl@0: test package-vsatisfies-3.1 "package vsatisfies multiple" tip268 {
sl@0:     #                      no  yes
sl@0:     package vsatisfies 8.4 7.3 8.4
sl@0: } 1
sl@0: 
sl@0: test package-vsatisfies-3.2 "package vsatisfies multiple" tip268 {
sl@0:     #                        yes  yes
sl@0:     package vsatisfies 8.4.2 8.4  8.4.1
sl@0: } 1
sl@0: 
sl@0: test package-vsatisfies-3.3 "package vsatisfies multiple" tip268 {
sl@0:     #                      no  no
sl@0:     package vsatisfies 8.4 7.3 6.1
sl@0: } 0
sl@0: 
sl@0: 
sl@0: proc prefer {args} {
sl@0:     set ip [interp create]
sl@0:     lappend res [$ip eval {package prefer}]
sl@0:     foreach mode $args {
sl@0: 	lappend res [$ip eval [list package prefer $mode]]
sl@0:     }
sl@0:     interp delete $ip
sl@0:     return $res
sl@0: }
sl@0: 
sl@0: test package-prefer-1.0 {default} tip268 {
sl@0:     prefer
sl@0: } stable
sl@0: 
sl@0: test package-prefer-1.1 {default} tip268 {
sl@0:     set   ::env(TCL_PKG_PREFER_LATEST) stable ; # value not relevant!
sl@0:     set res [prefer]
sl@0:     unset ::env(TCL_PKG_PREFER_LATEST)
sl@0:     set res
sl@0: } latest
sl@0: 
sl@0: test package-prefer-2.0 {wrong\#args} tip268 {
sl@0:     catch {package prefer foo bar} msg
sl@0:     set msg
sl@0: } {wrong # args: should be "package prefer ?latest|stable?"}
sl@0: 
sl@0: test package-prefer-2.1 {bogus argument} tip268 {
sl@0:     catch {package prefer foo} msg
sl@0:     set msg
sl@0: } {bad preference "foo": must be latest or stable}
sl@0: 
sl@0: test package-prefer-3.0 {set, keep} tip268 {
sl@0:     package prefer stable
sl@0: } stable
sl@0: 
sl@0: test package-prefer-3.1 {set stable, keep} tip268 {
sl@0:     prefer stable
sl@0: } {stable stable}
sl@0: 
sl@0: test package-prefer-3.2 {set latest, change} tip268 {
sl@0:     prefer latest
sl@0: } {stable latest}
sl@0: 
sl@0: test package-prefer-3.3 {set latest, keep} tip268 {
sl@0:     prefer  latest latest
sl@0: } {stable latest latest}
sl@0: 
sl@0: test package-prefer-3.4 {set stable, rejected} tip268 {
sl@0:     prefer latest stable
sl@0: } {stable latest latest}
sl@0: 
sl@0: rename prefer {}
sl@0: 
sl@0: 
sl@0: set auto_path $oldPath
sl@0: package unknown $oldPkgUnknown
sl@0: concat
sl@0: 
sl@0: cleanupTests
sl@0: }
sl@0: 
sl@0: # cleanup
sl@0: interp delete $i
sl@0: ::tcltest::cleanupTests
sl@0: return