| 1 | 578 | markom | # Commands covered:  pkg
 | 
      
         | 2 |  |  | #
 | 
      
         | 3 |  |  | # This file contains a collection of tests for one or more of the Tcl
 | 
      
         | 4 |  |  | # built-in commands.  Sourcing this file into Tcl runs the tests and
 | 
      
         | 5 |  |  | # generates output for errors.  No output means no errors were found.
 | 
      
         | 6 |  |  | #
 | 
      
         | 7 |  |  | # Copyright (c) 1995-1996 Sun Microsystems, Inc.
 | 
      
         | 8 |  |  | #
 | 
      
         | 9 |  |  | # See the file "license.terms" for information on usage and redistribution
 | 
      
         | 10 |  |  | # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 | 
      
         | 11 |  |  | #
 | 
      
         | 12 |  |  | # RCS: @(#) $Id: pkg.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $
 | 
      
         | 13 |  |  |  
 | 
      
         | 14 |  |  | if {[string compare test [info procs test]] == 1} then {source defs}
 | 
      
         | 15 |  |  |  
 | 
      
         | 16 |  |  | # Do all this in a slave interp to avoid garbaging the
 | 
      
         | 17 |  |  | # package list
 | 
      
         | 18 |  |  | set i [interp create]
 | 
      
         | 19 |  |  | interp eval $i [list set VERBOSE $VERBOSE]
 | 
      
         | 20 |  |  | interp eval $i [list set TESTS $TESTS]
 | 
      
         | 21 |  |  | interp eval $i {
 | 
      
         | 22 |  |  |  
 | 
      
         | 23 |  |  | if {[string compare test [info procs test]] == 1} then {source defs}
 | 
      
         | 24 |  |  |  
 | 
      
         | 25 |  |  | eval package forget [package names]
 | 
      
         | 26 |  |  | set oldPkgUnknown [package unknown]
 | 
      
         | 27 |  |  | package unknown {}
 | 
      
         | 28 |  |  | set oldPath $auto_path
 | 
      
         | 29 |  |  | set auto_path ""
 | 
      
         | 30 |  |  |  
 | 
      
         | 31 |  |  | test pkg-1.1 {Tcl_PkgProvide procedure} {
 | 
      
         | 32 |  |  |     package forget t
 | 
      
         | 33 |  |  |     package provide t 2.3
 | 
      
         | 34 |  |  | } {}
 | 
      
         | 35 |  |  | test pkg-1.2 {Tcl_PkgProvide procedure} {
 | 
      
         | 36 |  |  |     package forget t
 | 
      
         | 37 |  |  |     package provide t 2.3
 | 
      
         | 38 |  |  |     list [catch {package provide t 2.2} msg] $msg
 | 
      
         | 39 |  |  | } {1 {conflicting versions provided for package "t": 2.3, then 2.2}}
 | 
      
         | 40 |  |  | test pkg-1.3 {Tcl_PkgProvide procedure} {
 | 
      
         | 41 |  |  |     package forget t
 | 
      
         | 42 |  |  |     package provide t 2.3
 | 
      
         | 43 |  |  |     list [catch {package provide t 2.4} msg] $msg
 | 
      
         | 44 |  |  | } {1 {conflicting versions provided for package "t": 2.3, then 2.4}}
 | 
      
         | 45 |  |  | test pkg-1.4 {Tcl_PkgProvide procedure} {
 | 
      
         | 46 |  |  |     package forget t
 | 
      
         | 47 |  |  |     package provide t 2.3
 | 
      
         | 48 |  |  |     list [catch {package provide t 3.3} msg] $msg
 | 
      
         | 49 |  |  | } {1 {conflicting versions provided for package "t": 2.3, then 3.3}}
 | 
      
         | 50 |  |  | test pkg-1.5 {Tcl_PkgProvide procedure} {
 | 
      
         | 51 |  |  |     package forget t
 | 
      
         | 52 |  |  |     package provide t 2.3
 | 
      
         | 53 |  |  |     package provide t 2.3
 | 
      
         | 54 |  |  | } {}
 | 
      
         | 55 |  |  |  
 | 
      
         | 56 |  |  | test pkg-2.1 {Tcl_PkgRequire procedure, picking best version} {
 | 
      
         | 57 |  |  |     package forget t
 | 
      
         | 58 |  |  |     foreach i {1.4 3.4 2.3 2.4 2.2} {
 | 
      
         | 59 |  |  |         package ifneeded t $i "set x $i; package provide t $i"
 | 
      
         | 60 |  |  |     }
 | 
      
         | 61 |  |  |     set x xxx
 | 
      
         | 62 |  |  |     package require t
 | 
      
         | 63 |  |  |     set x
 | 
      
         | 64 |  |  | } {3.4}
 | 
      
         | 65 |  |  | test pkg-2.2 {Tcl_PkgRequire procedure, picking best version} {
 | 
      
         | 66 |  |  |     package forget t
 | 
      
         | 67 |  |  |     foreach i {1.4 3.4 2.3 2.4 2.2 3.5 3.2} {
 | 
      
         | 68 |  |  |         package ifneeded t $i "set x $i; package provide t $i"
 | 
      
         | 69 |  |  |     }
 | 
      
         | 70 |  |  |     set x xxx
 | 
      
         | 71 |  |  |     package require t
 | 
      
         | 72 |  |  |     set x
 | 
      
         | 73 |  |  | } {3.5}
 | 
      
         | 74 |  |  | test pkg-2.3 {Tcl_PkgRequire procedure, picking best version} {
 | 
      
         | 75 |  |  |     package forget t
 | 
      
         | 76 |  |  |     foreach i {3.5 2.1 2.3} {
 | 
      
         | 77 |  |  |         package ifneeded t $i "set x $i; package provide t $i"
 | 
      
         | 78 |  |  |     }
 | 
      
         | 79 |  |  |     set x xxx
 | 
      
         | 80 |  |  |     package require t 2.2
 | 
      
         | 81 |  |  |     set x
 | 
      
         | 82 |  |  | } {2.3}
 | 
      
         | 83 |  |  | test pkg-2.4 {Tcl_PkgRequire procedure, picking best version} {
 | 
      
         | 84 |  |  |     package forget t
 | 
      
         | 85 |  |  |     foreach i {1.4 3.4 2.3 2.4 2.2} {
 | 
      
         | 86 |  |  |         package ifneeded t $i "set x $i; package provide t $i"
 | 
      
         | 87 |  |  |     }
 | 
      
         | 88 |  |  |     set x xxx
 | 
      
         | 89 |  |  |     package require -exact t 2.3
 | 
      
         | 90 |  |  |     set x
 | 
      
         | 91 |  |  | } {2.3}
 | 
      
         | 92 |  |  | test pkg-2.5 {Tcl_PkgRequire procedure, picking best version} {
 | 
      
         | 93 |  |  |     package forget t
 | 
      
         | 94 |  |  |     foreach i {1.4 3.4 2.3 2.4 2.2} {
 | 
      
         | 95 |  |  |         package ifneeded t $i "set x $i; package provide t $i"
 | 
      
         | 96 |  |  |     }
 | 
      
         | 97 |  |  |     set x xxx
 | 
      
         | 98 |  |  |     package require t 2.1
 | 
      
         | 99 |  |  |     set x
 | 
      
         | 100 |  |  | } {2.4}
 | 
      
         | 101 |  |  | test pkg-2.6 {Tcl_PkgRequire procedure, can't find suitable version} {
 | 
      
         | 102 |  |  |     package forget t
 | 
      
         | 103 |  |  |     package unknown {}
 | 
      
         | 104 |  |  |     foreach i {1.4 3.4 2.3 2.4 2.2} {
 | 
      
         | 105 |  |  |         package ifneeded t $i "set x $i"
 | 
      
         | 106 |  |  |     }
 | 
      
         | 107 |  |  |     list [catch {package require t 2.5} msg] $msg
 | 
      
         | 108 |  |  | } {1 {can't find package t 2.5}}
 | 
      
         | 109 |  |  | test pkg-2.7 {Tcl_PkgRequire procedure, can't find suitable version} {
 | 
      
         | 110 |  |  |     package forget t
 | 
      
         | 111 |  |  |     package unknown {}
 | 
      
         | 112 |  |  |     foreach i {1.4 3.4 2.3 2.4 2.2} {
 | 
      
         | 113 |  |  |         package ifneeded t $i "set x $i"
 | 
      
         | 114 |  |  |     }
 | 
      
         | 115 |  |  |     list [catch {package require t 4.1} msg] $msg
 | 
      
         | 116 |  |  | } {1 {can't find package t 4.1}}
 | 
      
         | 117 |  |  | test pkg-2.8 {Tcl_PkgRequire procedure, can't find suitable version} {
 | 
      
         | 118 |  |  |     package forget t
 | 
      
         | 119 |  |  |     package unknown {}
 | 
      
         | 120 |  |  |     foreach i {1.4 3.4 2.3 2.4 2.2} {
 | 
      
         | 121 |  |  |         package ifneeded t $i "set x $i"
 | 
      
         | 122 |  |  |     }
 | 
      
         | 123 |  |  |     list [catch {package require -exact t 1.3} msg] $msg
 | 
      
         | 124 |  |  | } {1 {can't find package t 1.3}}
 | 
      
         | 125 |  |  | test pkg-2.9 {Tcl_PkgRequire procedure, can't find suitable version} {
 | 
      
         | 126 |  |  |     package forget t
 | 
      
         | 127 |  |  |     package unknown {}
 | 
      
         | 128 |  |  |     list [catch {package require t} msg] $msg
 | 
      
         | 129 |  |  | } {1 {can't find package t}}
 | 
      
         | 130 |  |  | test pkg-2.10 {Tcl_PkgRequire procedure, error in ifneeded script} {
 | 
      
         | 131 |  |  |     package forget t
 | 
      
         | 132 |  |  |     package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"}
 | 
      
         | 133 |  |  |     list [catch {package require t 2.1} msg] $msg $errorInfo
 | 
      
         | 134 |  |  | } {1 {ifneeded test} {ifneeded test
 | 
      
         | 135 |  |  |     while executing
 | 
      
         | 136 |  |  | "error "ifneeded test""
 | 
      
         | 137 |  |  |     ("package ifneeded" script)
 | 
      
         | 138 |  |  |     invoked from within
 | 
      
         | 139 |  |  | "package require t 2.1"}}
 | 
      
         | 140 |  |  | test pkg-2.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} {
 | 
      
         | 141 |  |  |     package forget t
 | 
      
         | 142 |  |  |     package ifneeded t 2.1 "set x invoked"
 | 
      
         | 143 |  |  |     set x xxx
 | 
      
         | 144 |  |  |     list [catch {package require t 2.1} msg] $msg $x
 | 
      
         | 145 |  |  | } {1 {can't find package t 2.1} invoked}
 | 
      
         | 146 |  |  | test pkg-2.12 {Tcl_PkgRequire procedure, self-deleting script} {
 | 
      
         | 147 |  |  |     package forget t
 | 
      
         | 148 |  |  |     package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2"
 | 
      
         | 149 |  |  |     set x xxx
 | 
      
         | 150 |  |  |     package require t 1.2
 | 
      
         | 151 |  |  |     set x
 | 
      
         | 152 |  |  | } {1.2}
 | 
      
         | 153 |  |  | test pkg-2.13 {Tcl_PkgRequire procedure, "package unknown" support} {
 | 
      
         | 154 |  |  |     proc pkgUnknown args {
 | 
      
         | 155 |  |  |         global x
 | 
      
         | 156 |  |  |         set x $args
 | 
      
         | 157 |  |  |         package provide [lindex $args 0] [lindex $args 1]
 | 
      
         | 158 |  |  |     }
 | 
      
         | 159 |  |  |     package forget t
 | 
      
         | 160 |  |  |     foreach i {1.4 3.4 2.3 2.4 2.2} {
 | 
      
         | 161 |  |  |         package ifneeded t $i "set x $i"
 | 
      
         | 162 |  |  |     }
 | 
      
         | 163 |  |  |     package unknown pkgUnknown
 | 
      
         | 164 |  |  |     set x xxx
 | 
      
         | 165 |  |  |     package require -exact t 1.5
 | 
      
         | 166 |  |  |     package unknown {}
 | 
      
         | 167 |  |  |     set x
 | 
      
         | 168 |  |  | } {t 1.5 -exact}
 | 
      
         | 169 |  |  | test pkg-2.14 {Tcl_PkgRequire procedure, "package unknown" support} {
 | 
      
         | 170 |  |  |     proc pkgUnknown args {
 | 
      
         | 171 |  |  |         package ifneeded t 1.2 "set x loaded; package provide t 1.2"
 | 
      
         | 172 |  |  |     }
 | 
      
         | 173 |  |  |     package forget t
 | 
      
         | 174 |  |  |     package unknown pkgUnknown
 | 
      
         | 175 |  |  |     set x xxx
 | 
      
         | 176 |  |  |     set result [list [package require t] $x]
 | 
      
         | 177 |  |  |     package unknown {}
 | 
      
         | 178 |  |  |     set result
 | 
      
         | 179 |  |  | } {1.2 loaded}
 | 
      
         | 180 |  |  | test pkg-2.15 {Tcl_PkgRequire procedure, "package unknown" support} {
 | 
      
         | 181 |  |  |     proc pkgUnknown args {
 | 
      
         | 182 |  |  |         global x
 | 
      
         | 183 |  |  |         set x $args
 | 
      
         | 184 |  |  |         package provide [lindex $args 0] 2.0
 | 
      
         | 185 |  |  |     }
 | 
      
         | 186 |  |  |     package forget {a b}
 | 
      
         | 187 |  |  |     package unknown pkgUnknown
 | 
      
         | 188 |  |  |     set x xxx
 | 
      
         | 189 |  |  |     package require {a b}
 | 
      
         | 190 |  |  |     package unknown {}
 | 
      
         | 191 |  |  |     set x
 | 
      
         | 192 |  |  | } {{a b} {}}
 | 
      
         | 193 |  |  | test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} {
 | 
      
         | 194 |  |  |     proc pkgUnknown args {
 | 
      
         | 195 |  |  |         error "testing package unknown"
 | 
      
         | 196 |  |  |     }
 | 
      
         | 197 |  |  |     package forget t
 | 
      
         | 198 |  |  |     package unknown pkgUnknown
 | 
      
         | 199 |  |  |     set result [list [catch {package require t} msg] $msg $errorInfo]
 | 
      
         | 200 |  |  |     package unknown {}
 | 
      
         | 201 |  |  |     set result
 | 
      
         | 202 |  |  | } {1 {testing package unknown} {testing package unknown
 | 
      
         | 203 |  |  |     while executing
 | 
      
         | 204 |  |  | "error "testing package unknown""
 | 
      
         | 205 |  |  |     (procedure "pkgUnknown" line 2)
 | 
      
         | 206 |  |  |     invoked from within
 | 
      
         | 207 |  |  | "pkgUnknown t {}"
 | 
      
         | 208 |  |  |     ("package unknown" script)
 | 
      
         | 209 |  |  |     invoked from within
 | 
      
         | 210 |  |  | "package require t"}}
 | 
      
         | 211 |  |  | test pkg-2.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} {
 | 
      
         | 212 |  |  |     proc pkgUnknown args {
 | 
      
         | 213 |  |  |         global x
 | 
      
         | 214 |  |  |         set x $args
 | 
      
         | 215 |  |  |     }
 | 
      
         | 216 |  |  |     package forget t
 | 
      
         | 217 |  |  |     foreach i {1.4 3.4 2.3 2.4 2.2} {
 | 
      
         | 218 |  |  |         package ifneeded t $i "set x $i"
 | 
      
         | 219 |  |  |     }
 | 
      
         | 220 |  |  |     package unknown pkgUnknown
 | 
      
         | 221 |  |  |     set x xxx
 | 
      
         | 222 |  |  |     set result [list [catch {package require -exact t 1.5} msg] $msg $x]
 | 
      
         | 223 |  |  |     package unknown {}
 | 
      
         | 224 |  |  |     set result
 | 
      
         | 225 |  |  | } {1 {can't find package t 1.5} {t 1.5 -exact}}
 | 
      
         | 226 |  |  | test pkg-2.18 {Tcl_PkgRequire procedure, version checks} {
 | 
      
         | 227 |  |  |     package forget t
 | 
      
         | 228 |  |  |     package provide t 2.3
 | 
      
         | 229 |  |  |     package require t
 | 
      
         | 230 |  |  | } {2.3}
 | 
      
         | 231 |  |  | test pkg-2.19 {Tcl_PkgRequire procedure, version checks} {
 | 
      
         | 232 |  |  |     package forget t
 | 
      
         | 233 |  |  |     package provide t 2.3
 | 
      
         | 234 |  |  |     package require t 2.1
 | 
      
         | 235 |  |  | } {2.3}
 | 
      
         | 236 |  |  | test pkg-2.20 {Tcl_PkgRequire procedure, version checks} {
 | 
      
         | 237 |  |  |     package forget t
 | 
      
         | 238 |  |  |     package provide t 2.3
 | 
      
         | 239 |  |  |     package require t 2.3
 | 
      
         | 240 |  |  | } {2.3}
 | 
      
         | 241 |  |  | test pkg-2.21 {Tcl_PkgRequire procedure, version checks} {
 | 
      
         | 242 |  |  |     package forget t
 | 
      
         | 243 |  |  |     package provide t 2.3
 | 
      
         | 244 |  |  |     list [catch {package require t 2.4} msg] $msg
 | 
      
         | 245 |  |  | } {1 {version conflict for package "t": have 2.3, need 2.4}}
 | 
      
         | 246 |  |  | test pkg-2.22 {Tcl_PkgRequire procedure, version checks} {
 | 
      
         | 247 |  |  |     package forget t
 | 
      
         | 248 |  |  |     package provide t 2.3
 | 
      
         | 249 |  |  |     list [catch {package require t 1.2} msg] $msg
 | 
      
         | 250 |  |  | } {1 {version conflict for package "t": have 2.3, need 1.2}}
 | 
      
         | 251 |  |  | test pkg-2.23 {Tcl_PkgRequire procedure, version checks} {
 | 
      
         | 252 |  |  |     package forget t
 | 
      
         | 253 |  |  |     package provide t 2.3
 | 
      
         | 254 |  |  |     package require -exact t 2.3
 | 
      
         | 255 |  |  | } {2.3}
 | 
      
         | 256 |  |  | test pkg-2.24 {Tcl_PkgRequire procedure, version checks} {
 | 
      
         | 257 |  |  |     package forget t
 | 
      
         | 258 |  |  |     package provide t 2.3
 | 
      
         | 259 |  |  |     list [catch {package require -exact t 2.2} msg] $msg
 | 
      
         | 260 |  |  | } {1 {version conflict for package "t": have 2.3, need 2.2}}
 | 
      
         | 261 |  |  |  
 | 
      
         | 262 |  |  | test pkg-3.1 {Tcl_PackageCmd procedure} {
 | 
      
         | 263 |  |  |     list [catch {package} msg] $msg
 | 
      
         | 264 |  |  | } {1 {wrong # args: should be "package option ?arg arg ...?"}}
 | 
      
         | 265 |  |  | test pkg-3.2 {Tcl_PackageCmd procedure, "forget" option} {
 | 
      
         | 266 |  |  |     foreach i [package names] {
 | 
      
         | 267 |  |  |         package forget $i
 | 
      
         | 268 |  |  |     }
 | 
      
         | 269 |  |  |     package names
 | 
      
         | 270 |  |  | } {}
 | 
      
         | 271 |  |  | test pkg-3.3 {Tcl_PackageCmd procedure, "forget" option} {
 | 
      
         | 272 |  |  |     foreach i [package names] {
 | 
      
         | 273 |  |  |         package forget $i
 | 
      
         | 274 |  |  |     }
 | 
      
         | 275 |  |  |     package forget foo
 | 
      
         | 276 |  |  | } {}
 | 
      
         | 277 |  |  | test pkg-3.4 {Tcl_PackageCmd procedure, "forget" option} {
 | 
      
         | 278 |  |  |     foreach i [package names] {
 | 
      
         | 279 |  |  |         package forget $i
 | 
      
         | 280 |  |  |     }
 | 
      
         | 281 |  |  |     package ifneeded t 1.1 {first script}
 | 
      
         | 282 |  |  |     package ifneeded t 2.3 {second script}
 | 
      
         | 283 |  |  |     package ifneeded x 1.4 {x's script}
 | 
      
         | 284 |  |  |     set result {}
 | 
      
         | 285 |  |  |     lappend result [lsort [package names]] [package versions t]
 | 
      
         | 286 |  |  |     package forget t
 | 
      
         | 287 |  |  |     lappend result [lsort [package names]] [package versions t]
 | 
      
         | 288 |  |  | } {{t x} {1.1 2.3} x {}}
 | 
      
         | 289 |  |  | test pkg-3.5 {Tcl_PackageCmd procedure, "forget" option} {
 | 
      
         | 290 |  |  |     foreach i [package names] {
 | 
      
         | 291 |  |  |         package forget $i
 | 
      
         | 292 |  |  |     }
 | 
      
         | 293 |  |  |     package ifneeded a 1.1 {first script}
 | 
      
         | 294 |  |  |     package ifneeded b 2.3 {second script}
 | 
      
         | 295 |  |  |     package ifneeded c 1.4 {third script}
 | 
      
         | 296 |  |  |     package forget
 | 
      
         | 297 |  |  |     set result [list [lsort [package names]]]
 | 
      
         | 298 |  |  |     package forget a c
 | 
      
         | 299 |  |  |     lappend result [lsort [package names]]
 | 
      
         | 300 |  |  | } {{a b c} b}
 | 
      
         | 301 |  |  | test pkg-3.6 {Tcl_PackageCmd procedure, "ifneeded" option} {
 | 
      
         | 302 |  |  |     list [catch {package ifneeded a} msg] $msg
 | 
      
         | 303 |  |  | } {1 {wrong # args: should be "package ifneeded package version ?script?"}}
 | 
      
         | 304 |  |  | test pkg-3.7 {Tcl_PackageCmd procedure, "ifneeded" option} {
 | 
      
         | 305 |  |  |     list [catch {package ifneeded a b c d} msg] $msg
 | 
      
         | 306 |  |  | } {1 {wrong # args: should be "package ifneeded package version ?script?"}}
 | 
      
         | 307 |  |  | test pkg-3.8 {Tcl_PackageCmd procedure, "ifneeded" option} {
 | 
      
         | 308 |  |  |     list [catch {package ifneeded t xyz} msg] $msg
 | 
      
         | 309 |  |  | } {1 {expected version number but got "xyz"}}
 | 
      
         | 310 |  |  | test pkg-3.9 {Tcl_PackageCmd procedure, "ifneeded" option} {
 | 
      
         | 311 |  |  |     foreach i [package names] {
 | 
      
         | 312 |  |  |         package forget $i
 | 
      
         | 313 |  |  |     }
 | 
      
         | 314 |  |  |     list [package ifneeded foo 1.1] [package names]
 | 
      
         | 315 |  |  | } {{} {}}
 | 
      
         | 316 |  |  | test pkg-3.10 {Tcl_PackageCmd procedure, "ifneeded" option} {
 | 
      
         | 317 |  |  |     package forget t
 | 
      
         | 318 |  |  |     package ifneeded t 1.4 "script for t 1.4"
 | 
      
         | 319 |  |  |     list [package names] [package ifneeded t 1.4] [package versions t]
 | 
      
         | 320 |  |  | } {t {script for t 1.4} 1.4}
 | 
      
         | 321 |  |  | test pkg-3.11 {Tcl_PackageCmd procedure, "ifneeded" option} {
 | 
      
         | 322 |  |  |     package forget t
 | 
      
         | 323 |  |  |     package ifneeded t 1.4 "script for t 1.4"
 | 
      
         | 324 |  |  |     list [package ifneeded t 1.5] [package names] [package versions t]
 | 
      
         | 325 |  |  | } {{} t 1.4}
 | 
      
         | 326 |  |  | test pkg-3.12 {Tcl_PackageCmd procedure, "ifneeded" option} {
 | 
      
         | 327 |  |  |     package forget t
 | 
      
         | 328 |  |  |     package ifneeded t 1.4 "script for t 1.4"
 | 
      
         | 329 |  |  |     package ifneeded t 1.4 "second script for t 1.4"
 | 
      
         | 330 |  |  |     list [package ifneeded t 1.4] [package names] [package versions t]
 | 
      
         | 331 |  |  | } {{second script for t 1.4} t 1.4}
 | 
      
         | 332 |  |  | test pkg-3.13 {Tcl_PackageCmd procedure, "ifneeded" option} {
 | 
      
         | 333 |  |  |     package forget t
 | 
      
         | 334 |  |  |     package ifneeded t 1.4 "script for t 1.4"
 | 
      
         | 335 |  |  |     package ifneeded t 1.2 "second script"
 | 
      
         | 336 |  |  |     package ifneeded t 3.1 "last script"
 | 
      
         | 337 |  |  |     list [package ifneeded t 1.2] [package versions t]
 | 
      
         | 338 |  |  | } {{second script} {1.4 1.2 3.1}}
 | 
      
         | 339 |  |  | test pkg-3.14 {Tcl_PackageCmd procedure, "names" option} {
 | 
      
         | 340 |  |  |     list [catch {package names a} msg] $msg
 | 
      
         | 341 |  |  | } {1 {wrong # args: should be "package names"}}
 | 
      
         | 342 |  |  | test pkg-3.15 {Tcl_PackageCmd procedure, "names" option} {
 | 
      
         | 343 |  |  |     foreach i [package names] {
 | 
      
         | 344 |  |  |         package forget $i
 | 
      
         | 345 |  |  |     }
 | 
      
         | 346 |  |  |     package names
 | 
      
         | 347 |  |  | } {}
 | 
      
         | 348 |  |  | test pkg-3.16 {Tcl_PackageCmd procedure, "names" option} {
 | 
      
         | 349 |  |  |     foreach i [package names] {
 | 
      
         | 350 |  |  |         package forget $i
 | 
      
         | 351 |  |  |     }
 | 
      
         | 352 |  |  |     package ifneeded x 1.2 {dummy}
 | 
      
         | 353 |  |  |     package provide x 1.3
 | 
      
         | 354 |  |  |     package provide y 2.4
 | 
      
         | 355 |  |  |     catch {package require z 47.16}
 | 
      
         | 356 |  |  |     lsort [package names]
 | 
      
         | 357 |  |  | } {x y}
 | 
      
         | 358 |  |  | test pkg-3.17 {Tcl_PackageCmd procedure, "provide" option} {
 | 
      
         | 359 |  |  |     list [catch {package provide} msg] $msg
 | 
      
         | 360 |  |  | } {1 {wrong # args: should be "package provide package ?version?"}}
 | 
      
         | 361 |  |  | test pkg-3.18 {Tcl_PackageCmd procedure, "provide" option} {
 | 
      
         | 362 |  |  |     list [catch {package provide a b c} msg] $msg
 | 
      
         | 363 |  |  | } {1 {wrong # args: should be "package provide package ?version?"}}
 | 
      
         | 364 |  |  | test pkg-3.19 {Tcl_PackageCmd procedure, "provide" option} {
 | 
      
         | 365 |  |  |     package forget t
 | 
      
         | 366 |  |  |     package provide t
 | 
      
         | 367 |  |  | } {}
 | 
      
         | 368 |  |  | test pkg-3.20 {Tcl_PackageCmd procedure, "provide" option} {
 | 
      
         | 369 |  |  |     package forget t
 | 
      
         | 370 |  |  |     package provide t 2.3
 | 
      
         | 371 |  |  |     package provide t
 | 
      
         | 372 |  |  | } {2.3}
 | 
      
         | 373 |  |  | test pkg-3.21 {Tcl_PackageCmd procedure, "provide" option} {
 | 
      
         | 374 |  |  |     package forget t
 | 
      
         | 375 |  |  |     list [catch {package provide t a.b} msg] $msg
 | 
      
         | 376 |  |  | } {1 {expected version number but got "a.b"}}
 | 
      
         | 377 |  |  | test pkg-3.22 {Tcl_PackageCmd procedure, "require" option} {
 | 
      
         | 378 |  |  |     list [catch {package require} msg] $msg
 | 
      
         | 379 |  |  | } {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
 | 
      
         | 380 |  |  | test pkg-3.23 {Tcl_PackageCmd procedure, "require" option} {
 | 
      
         | 381 |  |  |     list [catch {package require a b c} msg] $msg
 | 
      
         | 382 |  |  | } {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
 | 
      
         | 383 |  |  | test pkg-3.24 {Tcl_PackageCmd procedure, "require" option} {
 | 
      
         | 384 |  |  |     list [catch {package require -exact a b c} msg] $msg
 | 
      
         | 385 |  |  | } {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
 | 
      
         | 386 |  |  | test pkg-3.25 {Tcl_PackageCmd procedure, "require" option} {
 | 
      
         | 387 |  |  |     list [catch {package require -bs a b} msg] $msg
 | 
      
         | 388 |  |  | } {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
 | 
      
         | 389 |  |  | test pkg-3.26 {Tcl_PackageCmd procedure, "require" option} {
 | 
      
         | 390 |  |  |     list [catch {package require x a.b} msg] $msg
 | 
      
         | 391 |  |  | } {1 {expected version number but got "a.b"}}
 | 
      
         | 392 |  |  | test pkg-3.27 {Tcl_PackageCmd procedure, "require" option} {
 | 
      
         | 393 |  |  |     list [catch {package require -exact x a.b} msg] $msg
 | 
      
         | 394 |  |  | } {1 {expected version number but got "a.b"}}
 | 
      
         | 395 |  |  | test pkg-3.28 {Tcl_PackageCmd procedure, "require" option} {
 | 
      
         | 396 |  |  |     list [catch {package require -exact x} msg] $msg
 | 
      
         | 397 |  |  | } {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
 | 
      
         | 398 |  |  | test pkg-3.29 {Tcl_PackageCmd procedure, "require" option} {
 | 
      
         | 399 |  |  |     list [catch {package require -exact} msg] $msg
 | 
      
         | 400 |  |  | } {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
 | 
      
         | 401 |  |  | test pkg-3.30 {Tcl_PackageCmd procedure, "require" option} {
 | 
      
         | 402 |  |  |     package forget t
 | 
      
         | 403 |  |  |     package provide t 2.3
 | 
      
         | 404 |  |  |     package require t 2.1
 | 
      
         | 405 |  |  | } {2.3}
 | 
      
         | 406 |  |  | test pkg-3.31 {Tcl_PackageCmd procedure, "require" option} {
 | 
      
         | 407 |  |  |     package forget t
 | 
      
         | 408 |  |  |     list [catch {package require t} msg] $msg
 | 
      
         | 409 |  |  | } {1 {can't find package t}}
 | 
      
         | 410 |  |  | test pkg-3.32 {Tcl_PackageCmd procedure, "require" option} {
 | 
      
         | 411 |  |  |     package forget t
 | 
      
         | 412 |  |  |     package ifneeded t 2.3 "error {synthetic error}"
 | 
      
         | 413 |  |  |     list [catch {package require t 2.3} msg] $msg
 | 
      
         | 414 |  |  | } {1 {synthetic error}}
 | 
      
         | 415 |  |  | test pkg-3.33 {Tcl_PackageCmd procedure, "unknown" option} {
 | 
      
         | 416 |  |  |     list [catch {package unknown a b} msg] $msg
 | 
      
         | 417 |  |  | } {1 {wrong # args: should be "package unknown ?command?"}}
 | 
      
         | 418 |  |  | test pkg-3.34 {Tcl_PackageCmd procedure, "unknown" option} {
 | 
      
         | 419 |  |  |     package unknown "test script"
 | 
      
         | 420 |  |  |     package unknown
 | 
      
         | 421 |  |  | } {test script}
 | 
      
         | 422 |  |  | test pkg-3.35 {Tcl_PackageCmd procedure, "unknown" option} {
 | 
      
         | 423 |  |  |     package unknown "test script"
 | 
      
         | 424 |  |  |     package unknown {}
 | 
      
         | 425 |  |  |     package unknown
 | 
      
         | 426 |  |  | } {}
 | 
      
         | 427 |  |  | test pkg-3.36 {Tcl_PackageCmd procedure, "vcompare" option} {
 | 
      
         | 428 |  |  |     list [catch {package vcompare a} msg] $msg
 | 
      
         | 429 |  |  | } {1 {wrong # args: should be "package vcompare version1 version2"}}
 | 
      
         | 430 |  |  | test pkg-3.37 {Tcl_PackageCmd procedure, "vcompare" option} {
 | 
      
         | 431 |  |  |     list [catch {package vcompare a b c} msg] $msg
 | 
      
         | 432 |  |  | } {1 {wrong # args: should be "package vcompare version1 version2"}}
 | 
      
         | 433 |  |  | test pkg-3.38 {Tcl_PackageCmd procedure, "vcompare" option} {
 | 
      
         | 434 |  |  |     list [catch {package vcompare x.y 3.4} msg] $msg
 | 
      
         | 435 |  |  | } {1 {expected version number but got "x.y"}}
 | 
      
         | 436 |  |  | test pkg-3.39 {Tcl_PackageCmd procedure, "vcompare" option} {
 | 
      
         | 437 |  |  |     list [catch {package vcompare 2.1 a.b} msg] $msg
 | 
      
         | 438 |  |  | } {1 {expected version number but got "a.b"}}
 | 
      
         | 439 |  |  | test pkg-3.40 {Tcl_PackageCmd procedure, "vcompare" option} {
 | 
      
         | 440 |  |  |     package vc 2.1 2.3
 | 
      
         | 441 |  |  | } {-1}
 | 
      
         | 442 |  |  | test pkg-3.41 {Tcl_PackageCmd procedure, "vcompare" option} {
 | 
      
         | 443 |  |  |     package vc 2.2.4 2.2.4
 | 
      
         | 444 |  |  | } {0}
 | 
      
         | 445 |  |  | test pkg-3.42 {Tcl_PackageCmd procedure, "versions" option} {
 | 
      
         | 446 |  |  |     list [catch {package versions} msg] $msg
 | 
      
         | 447 |  |  | } {1 {wrong # args: should be "package versions package"}}
 | 
      
         | 448 |  |  | test pkg-3.43 {Tcl_PackageCmd procedure, "versions" option} {
 | 
      
         | 449 |  |  |     list [catch {package versions a b} msg] $msg
 | 
      
         | 450 |  |  | } {1 {wrong # args: should be "package versions package"}}
 | 
      
         | 451 |  |  | test pkg-3.44 {Tcl_PackageCmd procedure, "versions" option} {
 | 
      
         | 452 |  |  |     package forget t
 | 
      
         | 453 |  |  |     package versions t
 | 
      
         | 454 |  |  | } {}
 | 
      
         | 455 |  |  | test pkg-3.45 {Tcl_PackageCmd procedure, "versions" option} {
 | 
      
         | 456 |  |  |     package forget t
 | 
      
         | 457 |  |  |     package provide t 2.3
 | 
      
         | 458 |  |  |     package versions t
 | 
      
         | 459 |  |  | } {}
 | 
      
         | 460 |  |  | test pkg-3.46 {Tcl_PackageCmd procedure, "versions" option} {
 | 
      
         | 461 |  |  |     package forget t
 | 
      
         | 462 |  |  |     package ifneeded t 2.3 x
 | 
      
         | 463 |  |  |     package ifneeded t 2.4 y
 | 
      
         | 464 |  |  |     package versions t
 | 
      
         | 465 |  |  | } {2.3 2.4}
 | 
      
         | 466 |  |  | test pkg-3.47 {Tcl_PackageCmd procedure, "vsatisfies" option} {
 | 
      
         | 467 |  |  |     list [catch {package vsatisfies a} msg] $msg
 | 
      
         | 468 |  |  | } {1 {wrong # args: should be "package vsatisfies version1 version2"}}
 | 
      
         | 469 |  |  | test pkg-3.48 {Tcl_PackageCmd procedure, "vsatisfies" option} {
 | 
      
         | 470 |  |  |     list [catch {package vsatisfies a b c} msg] $msg
 | 
      
         | 471 |  |  | } {1 {wrong # args: should be "package vsatisfies version1 version2"}}
 | 
      
         | 472 |  |  | test pkg-3.49 {Tcl_PackageCmd procedure, "vsatisfies" option} {
 | 
      
         | 473 |  |  |     list [catch {package vsatisfies x.y 3.4} msg] $msg
 | 
      
         | 474 |  |  | } {1 {expected version number but got "x.y"}}
 | 
      
         | 475 |  |  | test pkg-3.50 {Tcl_PackageCmd procedure, "vsatisfies" option} {
 | 
      
         | 476 |  |  |     list [catch {package vcompare 2.1 a.b} msg] $msg
 | 
      
         | 477 |  |  | } {1 {expected version number but got "a.b"}}
 | 
      
         | 478 |  |  | test pkg-3.51 {Tcl_PackageCmd procedure, "vsatisfies" option} {
 | 
      
         | 479 |  |  |     package vs 2.3 2.1
 | 
      
         | 480 |  |  | } {1}
 | 
      
         | 481 |  |  | test pkg-3.52 {Tcl_PackageCmd procedure, "vsatisfies" option} {
 | 
      
         | 482 |  |  |     package vs 2.3 1.2
 | 
      
         | 483 |  |  | } {0}
 | 
      
         | 484 |  |  | test pkg-3.53 {Tcl_PackageCmd procedure, "versions" option} {
 | 
      
         | 485 |  |  |     list [catch {package foo} msg] $msg
 | 
      
         | 486 |  |  | } {1 {bad option "foo": should be forget, ifneeded, names, provide, require, unknown, vcompare, versions, or vsatisfies}}
 | 
      
         | 487 |  |  |  
 | 
      
         | 488 |  |  | # No tests for FindPackage;  can't think up anything detectable
 | 
      
         | 489 |  |  | # errors.
 | 
      
         | 490 |  |  |  
 | 
      
         | 491 |  |  | test pkg-4.1 {TclFreePackageInfo procedure} {
 | 
      
         | 492 |  |  |     interp create foo
 | 
      
         | 493 |  |  |     foo eval {
 | 
      
         | 494 |  |  |         package ifneeded t 2.3 x
 | 
      
         | 495 |  |  |         package ifneeded t 2.4 y
 | 
      
         | 496 |  |  |         package ifneeded x 3.1 z
 | 
      
         | 497 |  |  |         package provide q 4.3
 | 
      
         | 498 |  |  |         package unknown "will this get freed?"
 | 
      
         | 499 |  |  |     }
 | 
      
         | 500 |  |  |     interp delete foo
 | 
      
         | 501 |  |  | } {}
 | 
      
         | 502 |  |  | test pkg-4.2 {TclFreePackageInfo procedure} {
 | 
      
         | 503 |  |  |     interp create foo
 | 
      
         | 504 |  |  |     foo eval {
 | 
      
         | 505 |  |  |         package ifneeded t 2.3 x
 | 
      
         | 506 |  |  |         package ifneeded t 2.4 y
 | 
      
         | 507 |  |  |         package ifneeded x 3.1 z
 | 
      
         | 508 |  |  |         package provide q 4.3
 | 
      
         | 509 |  |  |     }
 | 
      
         | 510 |  |  |     foo alias z kill
 | 
      
         | 511 |  |  |     proc kill {} {
 | 
      
         | 512 |  |  |         interp delete foo
 | 
      
         | 513 |  |  |     }
 | 
      
         | 514 |  |  |     list [catch {foo eval package require x 3.1} msg] $msg
 | 
      
         | 515 |  |  | } {1 {can't find package x 3.1}}
 | 
      
         | 516 |  |  |  
 | 
      
         | 517 |  |  | test pkg-5.1 {CheckVersion procedure} {
 | 
      
         | 518 |  |  |     list [catch {package vcompare 1 2.1} msg] $msg
 | 
      
         | 519 |  |  | } {0 -1}
 | 
      
         | 520 |  |  | test pkg-5.2 {CheckVersion procedure} {
 | 
      
         | 521 |  |  |     list [catch {package vcompare .1 2.1} msg] $msg
 | 
      
         | 522 |  |  | } {1 {expected version number but got ".1"}}
 | 
      
         | 523 |  |  | test pkg-5.3 {CheckVersion procedure} {
 | 
      
         | 524 |  |  |     list [catch {package vcompare 111.2a.3 2.1} msg] $msg
 | 
      
         | 525 |  |  | } {1 {expected version number but got "111.2a.3"}}
 | 
      
         | 526 |  |  | test pkg-5.4 {CheckVersion procedure} {
 | 
      
         | 527 |  |  |     list [catch {package vcompare 1.2.3. 2.1} msg] $msg
 | 
      
         | 528 |  |  | } {1 {expected version number but got "1.2.3."}}
 | 
      
         | 529 |  |  |  
 | 
      
         | 530 |  |  | test pkg-6.1 {ComparePkgVersions procedure} {
 | 
      
         | 531 |  |  |     package vcompare 1.23 1.22
 | 
      
         | 532 |  |  | } {1}
 | 
      
         | 533 |  |  | test pkg-6.2 {ComparePkgVersions procedure} {
 | 
      
         | 534 |  |  |     package vcompare 1.22.1.2.3 1.22.1.2.3
 | 
      
         | 535 |  |  | } {0}
 | 
      
         | 536 |  |  | test pkg-6.3 {ComparePkgVersions procedure} {
 | 
      
         | 537 |  |  |     package vcompare 1.21 1.22
 | 
      
         | 538 |  |  | } {-1}
 | 
      
         | 539 |  |  | test pkg-6.4 {ComparePkgVersions procedure} {
 | 
      
         | 540 |  |  |     package vcompare 1.21 1.21.2
 | 
      
         | 541 |  |  | } {-1}
 | 
      
         | 542 |  |  | test pkg-6.5 {ComparePkgVersions procedure} {
 | 
      
         | 543 |  |  |     package vcompare 1.21.1 1.21
 | 
      
         | 544 |  |  | } {1}
 | 
      
         | 545 |  |  | test pkg-6.6 {ComparePkgVersions procedure} {
 | 
      
         | 546 |  |  |     package vsatisfies 1.21.1 1.21
 | 
      
         | 547 |  |  | } {1}
 | 
      
         | 548 |  |  | test pkg-6.7 {ComparePkgVersions procedure} {
 | 
      
         | 549 |  |  |     package vsatisfies 2.22.3 1.21
 | 
      
         | 550 |  |  | } {0}
 | 
      
         | 551 |  |  | test pkg-6.8 {ComparePkgVersions procedure} {
 | 
      
         | 552 |  |  |     package vsatisfies 1 1
 | 
      
         | 553 |  |  | } {1}
 | 
      
         | 554 |  |  | test pkg-6.9 {ComparePkgVersions procedure} {
 | 
      
         | 555 |  |  |     package vsatisfies 2 1
 | 
      
         | 556 |  |  | } {0}
 | 
      
         | 557 |  |  |  
 | 
      
         | 558 |  |  | set auto_path $oldPath
 | 
      
         | 559 |  |  | package unknown $oldPkgUnknown
 | 
      
         | 560 |  |  | concat
 | 
      
         | 561 |  |  |  
 | 
      
         | 562 |  |  | }
 | 
      
         | 563 |  |  | interp delete $i
 |