1# -*- tcl -*- 2# Commands covered: pkg 3# 4# This file contains a collection of tests for one or more of the Tcl 5# built-in commands. Sourcing this file into Tcl runs the tests and 6# generates output for errors. No output means no errors were found. 7# 8# Copyright (c) 1995-1996 Sun Microsystems, Inc. 9# Copyright (c) 1998-1999 by Scriptics Corporation. 10# 11# See the file "license.terms" for information on usage and redistribution 12# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 13 14if {[lsearch [namespace children] ::tcltest] == -1} { 15 package require tcltest 2.3.4 16 namespace import -force ::tcltest::* 17} 18 19# Do all this in a slave interp to avoid garbaging the 20# package list 21set i [interp create] 22tcltest::loadIntoSlaveInterpreter $i {*}$argv 23 24interp eval $i { 25namespace import -force ::tcltest::* 26package forget {*}[package names] 27set oldPkgUnknown [package unknown] 28package unknown {} 29set oldPath $auto_path 30set auto_path "" 31 32test pkg-1.1 {Tcl_PkgProvide procedure} { 33 package forget t 34 package provide t 2.3 35} {} 36test pkg-1.2 {Tcl_PkgProvide procedure} { 37 package forget t 38 package provide t 2.3 39 list [catch {package provide t 2.2} msg] $msg 40} {1 {conflicting versions provided for package "t": 2.3, then 2.2}} 41test pkg-1.3 {Tcl_PkgProvide procedure} { 42 package forget t 43 package provide t 2.3 44 list [catch {package provide t 2.4} msg] $msg 45} {1 {conflicting versions provided for package "t": 2.3, then 2.4}} 46test pkg-1.4 {Tcl_PkgProvide procedure} { 47 package forget t 48 package provide t 2.3 49 list [catch {package provide t 3.3} msg] $msg 50} {1 {conflicting versions provided for package "t": 2.3, then 3.3}} 51test pkg-1.5 {Tcl_PkgProvide procedure} { 52 package forget t 53 package provide t 2.3 54 package provide t 2.3 55} {} 56 57test pkg-1.6 {Tcl_PkgProvide procedure} { 58 package forget t 59 package provide t 2.3a1 60} {} 61 62set n 0 63foreach v { 64 2.3k1 2a3a2 2ab3 2.a4 2.b4 2b.4 2a.4 2ba4 2a4b1 65 2b4a1 2b3b2 66} { 67 test pkg-1.7.$n {Tcl_PkgProvide procedure} { 68 package forget t 69 list [catch {package provide t $v} msg] $msg 70 } [list 1 "expected version number but got \"$v\""] 71 incr n 72} 73 74test pkg-2.1 {Tcl_PkgRequire procedure, picking best version} { 75 package forget t 76 foreach i {1.4 3.4 2.3 2.4 2.2} { 77 package ifneeded t $i "set x $i; package provide t $i" 78 } 79 set x xxx 80 package require t 81 set x 82} {3.4} 83test pkg-2.2 {Tcl_PkgRequire procedure, picking best version} { 84 package forget t 85 foreach i {1.4 3.4 2.3 2.4 2.2 3.5 3.2} { 86 package ifneeded t $i "set x $i; package provide t $i" 87 } 88 set x xxx 89 package require t 90 set x 91} {3.5} 92test pkg-2.3 {Tcl_PkgRequire procedure, picking best version} { 93 package forget t 94 foreach i {3.5 2.1 2.3} { 95 package ifneeded t $i "set x $i; package provide t $i" 96 } 97 set x xxx 98 package require t 2.2 99 set x 100} {2.3} 101test pkg-2.4 {Tcl_PkgRequire procedure, picking best version} { 102 package forget t 103 foreach i {1.4 3.4 2.3 2.4 2.2} { 104 package ifneeded t $i "set x $i; package provide t $i" 105 } 106 set x xxx 107 package require -exact t 2.3 108 set x 109} {2.3} 110test pkg-2.5 {Tcl_PkgRequire procedure, picking best version} { 111 package forget t 112 foreach i {1.4 3.4 2.3 2.4 2.2} { 113 package ifneeded t $i "set x $i; package provide t $i" 114 } 115 set x xxx 116 package require t 2.1 117 set x 118} {2.4} 119test pkg-2.6 {Tcl_PkgRequire procedure, can't find suitable version} { 120 package forget t 121 package unknown {} 122 foreach i {1.4 3.4 2.3 2.4 2.2} { 123 package ifneeded t $i "set x $i" 124 } 125 list [catch {package require t 2.5} msg] $msg 126} {1 {can't find package t 2.5}} 127test pkg-2.7 {Tcl_PkgRequire procedure, can't find suitable version} { 128 package forget t 129 package unknown {} 130 foreach i {1.4 3.4 2.3 2.4 2.2} { 131 package ifneeded t $i "set x $i" 132 } 133 list [catch {package require t 4.1} msg] $msg 134} {1 {can't find package t 4.1}} 135test pkg-2.8 {Tcl_PkgRequire procedure, can't find suitable version} { 136 package forget t 137 package unknown {} 138 foreach i {1.4 3.4 2.3 2.4 2.2} { 139 package ifneeded t $i "set x $i" 140 } 141 list [catch {package require -exact t 1.3} msg] $msg 142} {1 {can't find package t exactly 1.3}} 143test pkg-2.9 {Tcl_PkgRequire procedure, can't find suitable version} { 144 package forget t 145 package unknown {} 146 list [catch {package require t} msg] $msg 147} {1 {can't find package t}} 148test pkg-2.10 {Tcl_PkgRequire procedure, error in ifneeded script} -body { 149 package forget t 150 package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"} 151 list [catch {package require t 2.1} msg] $msg $::errorInfo 152} -match glob -result {1 {ifneeded test} {ifneeded test 153 while executing 154"error "ifneeded test"" 155 ("package ifneeded*" script) 156 invoked from within 157"package require t 2.1"}} 158test pkg-2.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} -body { 159 package forget t 160 package ifneeded t 2.1 "set x invoked" 161 set x xxx 162 list [catch {package require t 2.1} msg] $msg $x 163} -match glob -result {1 * invoked} 164test pkg-2.12 {Tcl_PkgRequire procedure, self-deleting script} { 165 package forget t 166 package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2" 167 set x xxx 168 package require t 1.2 169 set x 170} {1.2} 171test pkg-2.13 {Tcl_PkgRequire procedure, "package unknown" support} { 172 proc pkgUnknown args { 173 # args = name requirement 174 # requirement = v-v (for exact version) 175 global x 176 set x $args 177 package provide [lindex $args 0] [lindex [split [lindex $args 1] -] 0] 178 } 179 package forget t 180 foreach i {1.4 3.4 2.3 2.4 2.2} { 181 package ifneeded t $i "set x $i" 182 } 183 package unknown pkgUnknown 184 set x xxx 185 package require -exact t 1.5 186 package unknown {} 187 set x 188} {t 1.5-1.5} 189test pkg-2.14 {Tcl_PkgRequire procedure, "package unknown" support} { 190 proc pkgUnknown args { 191 package ifneeded t 1.2 "set x loaded; package provide t 1.2" 192 } 193 package forget t 194 package unknown pkgUnknown 195 set x xxx 196 set result [list [package require t] $x] 197 package unknown {} 198 set result 199} {1.2 loaded} 200test pkg-2.15 {Tcl_PkgRequire procedure, "package unknown" support} { 201 proc pkgUnknown args { 202 global x 203 set x $args 204 package provide [lindex $args 0] 2.0 205 } 206 package forget {a b} 207 package unknown pkgUnknown 208 set x xxx 209 package require {a b} 210 package unknown {} 211 set x 212} {{a b} 0-} 213test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} { 214 proc pkgUnknown args { 215 error "testing package unknown" 216 } 217 package forget t 218 package unknown pkgUnknown 219 set result [list [catch {package require t} msg] $msg $::errorInfo] 220 package unknown {} 221 set result 222} {1 {testing package unknown} {testing package unknown 223 while executing 224"error "testing package unknown"" 225 (procedure "pkgUnknown" line 2) 226 invoked from within 227"pkgUnknown t 0-" 228 ("package unknown" script) 229 invoked from within 230"package require t"}} 231test pkg-2.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} { 232 proc pkgUnknown args { 233 global x 234 set x $args 235 } 236 package forget t 237 foreach i {1.4 3.4 2.3 2.4 2.2} { 238 package ifneeded t $i "set x $i" 239 } 240 package unknown pkgUnknown 241 set x xxx 242 set result [list [catch {package require -exact t 1.5} msg] $msg $x] 243 package unknown {} 244 set result 245} {1 {can't find package t exactly 1.5} {t 1.5-1.5}} 246test pkg-2.18 {Tcl_PkgRequire procedure, version checks} { 247 package forget t 248 package provide t 2.3 249 package require t 250} {2.3} 251test pkg-2.19 {Tcl_PkgRequire procedure, version checks} { 252 package forget t 253 package provide t 2.3 254 package require t 2.1 255} {2.3} 256test pkg-2.20 {Tcl_PkgRequire procedure, version checks} { 257 package forget t 258 package provide t 2.3 259 package require t 2.3 260} {2.3} 261test pkg-2.21 {Tcl_PkgRequire procedure, version checks} { 262 package forget t 263 package provide t 2.3 264 list [catch {package require t 2.4} msg] $msg 265} {1 {version conflict for package "t": have 2.3, need 2.4}} 266test pkg-2.22 {Tcl_PkgRequire procedure, version checks} { 267 package forget t 268 package provide t 2.3 269 list [catch {package require t 1.2} msg] $msg 270} {1 {version conflict for package "t": have 2.3, need 1.2}} 271test pkg-2.23 {Tcl_PkgRequire procedure, version checks} { 272 package forget t 273 package provide t 2.3 274 package require -exact t 2.3 275} {2.3} 276test pkg-2.24 {Tcl_PkgRequire procedure, version checks} { 277 package forget t 278 package provide t 2.3 279 list [catch {package require -exact t 2.2} msg] $msg 280} {1 {version conflict for package "t": have 2.3, need exactly 2.2}} 281test pkg-2.25 {Tcl_PkgRequire procedure, error in ifneeded script} -body { 282 package forget t 283 package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test" EI} 284 list [catch {package require t 2.1} msg] $msg $::errorInfo 285} -match glob -result {1 {ifneeded test} {EI 286 ("package ifneeded*" script) 287 invoked from within 288"package require t 2.1"}} 289test pkg-2.26 {Tcl_PkgRequire procedure, error in ifneeded script} -body { 290 package forget t 291 package ifneeded t 2.1 {package provide t 2.1; foreach x 1 {error "ifneeded test" EI}} 292 list [catch {package require t 2.1} msg] $msg $::errorInfo 293} -match glob -result {1 {ifneeded test} {EI 294 ("foreach" body line 1) 295 invoked from within 296"foreach x 1 {error "ifneeded test" EI}" 297 ("package ifneeded*" script) 298 invoked from within 299"package require t 2.1"}} 300test pkg-2.27 {Tcl_PkgRequire: circular dependency} -setup { 301 package forget foo 302} -body { 303 package ifneeded foo 1 {package require foo 1} 304 package require foo 1 305} -cleanup { 306 package forget foo 307} -returnCodes error -match glob -result {circular package dependency:*} 308test pkg-2.28 {Tcl_PkgRequire: circular dependency} -setup { 309 package forget foo 310} -body { 311 package ifneeded foo 1 {package require foo 2} 312 package require foo 1 313} -cleanup { 314 package forget foo 315} -returnCodes error -match glob -result {circular package dependency:*} 316test pkg-2.29 {Tcl_PkgRequire: circular dependency} -setup { 317 package forget foo 318 package forget bar 319} -body { 320 package ifneeded foo 1 {package require bar 1; package provide foo 1} 321 package ifneeded bar 1 {package require foo 1; package provide bar 1} 322 package require foo 1 323} -cleanup { 324 package forget foo 325 package forget bar 326} -returnCodes error -match glob -result {circular package dependency:*} 327test pkg-2.30 {Tcl_PkgRequire: circular dependency} -setup { 328 package forget foo 329 package forget bar 330} -body { 331 package ifneeded foo 1 {package require bar 1; package provide foo 1} 332 package ifneeded foo 2 {package provide foo 2} 333 package ifneeded bar 1 {package require foo 2; package provide bar 1} 334 package require foo 1 335} -cleanup { 336 package forget foo 337 package forget bar 338} -returnCodes error -match glob -result {circular package dependency:*} 339test pkg-2.31 {Tcl_PkgRequire: consistent return values (1162286)} -setup { 340 package forget foo 341} -body { 342 package ifneeded foo 1 {package provide foo 1; error foo} 343 package require foo 1 344} -cleanup { 345 package forget foo 346} -returnCodes error -match glob -result foo 347test pkg-2.32 {Tcl_PkgRequire: consistent return values (1162286)} -setup { 348 package forget foo 349} -body { 350 package ifneeded foo 1 {package provide foo 1; error foo} 351 catch {package require foo 1} 352 package provide foo 353} -cleanup { 354 package forget foo 355} -result {} 356test pkg-2.33 {Tcl_PkgRequire: consistent return values (1162286)} -setup { 357 package forget foo 358} -body { 359 package ifneeded foo 1 {package provide foo 2} 360 package require foo 1 361} -cleanup { 362 package forget foo 363} -returnCodes error -match glob -result {attempt to provide package * failed:*} 364test pkg-2.34 {Tcl_PkgRequire: consistent return values (1162286)} -setup { 365 package forget foo 366} -body { 367 package ifneeded foo 1 {package provide foo 1.1} 368 package require foo 1 369} -cleanup { 370 package forget foo 371} -returnCodes error -match glob -result {attempt to provide package * failed:*} 372test pkg-2.34.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup { 373 package forget foo 374} -body { 375 package ifneeded foo 1.1 {package provide foo 1} 376 package require foo 1 377} -cleanup { 378 package forget foo 379} -returnCodes error -match glob -result {attempt to provide package * failed:*} 380test pkg-2.34.2 {Tcl_PkgRequire: consistent return values (1162286)} -setup { 381 package forget foo 382} -body { 383 package ifneeded foo 1.1 {package provide foo 1} 384 package require foo 1.1 385} -cleanup { 386 package forget foo 387} -returnCodes error -match glob -result {attempt to provide package * failed:*} 388test pkg-2.35 {Tcl_PkgRequire: consistent return values (1162286)} -setup { 389 package forget foo 390} -body { 391 package ifneeded foo 1 {} 392 package require foo 1 393} -cleanup { 394 package forget foo 395} -returnCodes error -match glob -result {attempt to provide package * failed:*} 396test pkg-2.35.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup { 397 package forget foo 398} -body { 399 package ifneeded foo 1 {break} 400 package require foo 1 401} -cleanup { 402 package forget foo 403} -returnCodes error -match glob \ 404-result {attempt to provide package * failed: bad return code:*} 405test pkg-2.36 {Tcl_PkgRequire: consistent return values (1162286)} -setup { 406 package forget foo 407} -body { 408 package ifneeded foo 1 {continue} 409 package require foo 1 410} -cleanup { 411 package forget foo 412} -returnCodes error -match glob \ 413-result {attempt to provide package * failed: bad return code:*} 414test pkg-2.37 {Tcl_PkgRequire: consistent return values (1162286)} -setup { 415 package forget foo 416} -body { 417 package ifneeded foo 1 {return} 418 package require foo 1 419} -cleanup { 420 package forget foo 421} -returnCodes error -match glob \ 422-result {attempt to provide package * failed: bad return code:*} 423test pkg-2.38 {Tcl_PkgRequire: consistent return values (1162286)} -setup { 424 package forget foo 425} -body { 426 package ifneeded foo 1 {return -level 0 -code 10} 427 package require foo 1 428} -cleanup { 429 package forget foo 430} -returnCodes error -match glob \ 431-result {attempt to provide package * failed: bad return code:*} 432test pkg-2.39 {Tcl_PkgRequire: consistent return values (1162286)} -setup { 433 package forget foo 434 set saveUnknown [package unknown] 435 package unknown {package provide foo 2 ;#} 436} -body { 437 package require foo 1 438} -cleanup { 439 package forget foo 440 package unknown $saveUnknown 441} -returnCodes error -match glob -result * 442test pkg-2.40 {Tcl_PkgRequire: consistent return values (1162286)} -setup { 443 package forget foo 444 set saveUnknown [package unknown] 445 package unknown {break ;#} 446} -body { 447 package require foo 1 448} -cleanup { 449 package forget foo 450 package unknown $saveUnknown 451} -returnCodes error -match glob -result {bad return code:*} 452test pkg-2.41 {Tcl_PkgRequire: consistent return values (1162286)} -setup { 453 package forget foo 454 set saveUnknown [package unknown] 455 package unknown {continue ;#} 456} -body { 457 package require foo 1 458} -cleanup { 459 package forget foo 460 package unknown $saveUnknown 461} -returnCodes error -match glob -result {bad return code:*} 462test pkg-2.42 {Tcl_PkgRequire: consistent return values (1162286)} -setup { 463 package forget foo 464 set saveUnknown [package unknown] 465 package unknown {return ;#} 466} -body { 467 package require foo 1 468} -cleanup { 469 package forget foo 470 package unknown $saveUnknown 471} -returnCodes error -match glob -result {bad return code:*} 472test pkg-2.43 {Tcl_PkgRequire: consistent return values (1162286)} -setup { 473 package forget foo 474 set saveUnknown [package unknown] 475 package unknown {return -level 0 -code 10 ;#} 476} -body { 477 package require foo 1 478} -cleanup { 479 package forget foo 480 package unknown $saveUnknown 481} -returnCodes error -match glob -result {bad return code:*} 482test pkg-2.44 {Tcl_PkgRequire: exact version matching (1578344)} -setup { 483 package provide demo 1.2.3 484} -body { 485 package require -exact demo 1.2 486} -cleanup { 487 package forget demo 488} -returnCodes error -result {version conflict for package "demo": have 1.2.3, need exactly 1.2} 489 490 491test pkg-2.50 {Tcl_PkgRequire procedure, picking best stable version} { 492 package forget t 493 foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} { 494 package ifneeded t $i "set x $i; package provide t $i" 495 } 496 set x xxx 497 package require t 498 set x 499} {3.4} 500 501test pkg-2.51 {Tcl_PkgRequire procedure, picking best stable version} { 502 package forget t 503 foreach i {1.2b1 1.2 1.3a2 1.3} { 504 package ifneeded t $i "set x $i; package provide t $i" 505 } 506 set x xxx 507 package require t 508 set x 509} {1.3} 510 511test pkg-2.52 {Tcl_PkgRequire procedure, picking best stable version} { 512 package forget t 513 foreach i {1.2b1 1.2 1.3 1.3a2} { 514 package ifneeded t $i "set x $i; package provide t $i" 515 } 516 set x xxx 517 package require t 518 set x 519} {1.3} 520 521 522 523test pkg-3.1 {Tcl_PackageCmd procedure} { 524 list [catch {package} msg] $msg 525} {1 {wrong # args: should be "package option ?arg arg ...?"}} 526test pkg-3.2 {Tcl_PackageCmd procedure, "forget" option} { 527 foreach i [package names] { 528 package forget $i 529 } 530 package names 531} {} 532test pkg-3.3 {Tcl_PackageCmd procedure, "forget" option} { 533 foreach i [package names] { 534 package forget $i 535 } 536 package forget foo 537} {} 538test pkg-3.4 {Tcl_PackageCmd procedure, "forget" option} { 539 foreach i [package names] { 540 package forget $i 541 } 542 package ifneeded t 1.1 {first script} 543 package ifneeded t 2.3 {second script} 544 package ifneeded x 1.4 {x's script} 545 set result {} 546 lappend result [lsort [package names]] [package versions t] 547 package forget t 548 lappend result [lsort [package names]] [package versions t] 549} {{t x} {1.1 2.3} x {}} 550test pkg-3.5 {Tcl_PackageCmd procedure, "forget" option} { 551 foreach i [package names] { 552 package forget $i 553 } 554 package ifneeded a 1.1 {first script} 555 package ifneeded b 2.3 {second script} 556 package ifneeded c 1.4 {third script} 557 package forget 558 set result [list [lsort [package names]]] 559 package forget a c 560 lappend result [lsort [package names]] 561} {{a b c} b} 562test pkg-3.5.1 {Tcl_PackageCmd procedure, "forget" option} { 563 # Test for Bug 415273 564 package ifneeded a 1 "I should have been forgotten" 565 package forget no-such-package a 566 set x [package ifneeded a 1] 567 package forget a 568 set x 569} {} 570test pkg-3.6 {Tcl_PackageCmd procedure, "ifneeded" option} { 571 list [catch {package ifneeded a} msg] $msg 572} {1 {wrong # args: should be "package ifneeded package version ?script?"}} 573test pkg-3.7 {Tcl_PackageCmd procedure, "ifneeded" option} { 574 list [catch {package ifneeded a b c d} msg] $msg 575} {1 {wrong # args: should be "package ifneeded package version ?script?"}} 576test pkg-3.8 {Tcl_PackageCmd procedure, "ifneeded" option} { 577 list [catch {package ifneeded t xyz} msg] $msg 578} {1 {expected version number but got "xyz"}} 579test pkg-3.9 {Tcl_PackageCmd procedure, "ifneeded" option} { 580 foreach i [package names] { 581 package forget $i 582 } 583 list [package ifneeded foo 1.1] [package names] 584} {{} {}} 585test pkg-3.10 {Tcl_PackageCmd procedure, "ifneeded" option} { 586 package forget t 587 package ifneeded t 1.4 "script for t 1.4" 588 list [package names] [package ifneeded t 1.4] [package versions t] 589} {t {script for t 1.4} 1.4} 590test pkg-3.11 {Tcl_PackageCmd procedure, "ifneeded" option} { 591 package forget t 592 package ifneeded t 1.4 "script for t 1.4" 593 list [package ifneeded t 1.5] [package names] [package versions t] 594} {{} t 1.4} 595test pkg-3.12 {Tcl_PackageCmd procedure, "ifneeded" option} { 596 package forget t 597 package ifneeded t 1.4 "script for t 1.4" 598 package ifneeded t 1.4 "second script for t 1.4" 599 list [package ifneeded t 1.4] [package names] [package versions t] 600} {{second script for t 1.4} t 1.4} 601test pkg-3.13 {Tcl_PackageCmd procedure, "ifneeded" option} { 602 package forget t 603 package ifneeded t 1.4 "script for t 1.4" 604 package ifneeded t 1.2 "second script" 605 package ifneeded t 3.1 "last script" 606 list [package ifneeded t 1.2] [package versions t] 607} {{second script} {1.4 1.2 3.1}} 608test pkg-3.14 {Tcl_PackageCmd procedure, "names" option} { 609 list [catch {package names a} msg] $msg 610} {1 {wrong # args: should be "package names"}} 611test pkg-3.15 {Tcl_PackageCmd procedure, "names" option} { 612 foreach i [package names] { 613 package forget $i 614 } 615 package names 616} {} 617test pkg-3.16 {Tcl_PackageCmd procedure, "names" option} { 618 foreach i [package names] { 619 package forget $i 620 } 621 package ifneeded x 1.2 {dummy} 622 package provide x 1.3 623 package provide y 2.4 624 catch {package require z 47.16} 625 lsort [package names] 626} {x y} 627test pkg-3.17 {Tcl_PackageCmd procedure, "provide" option} { 628 list [catch {package provide} msg] $msg 629} {1 {wrong # args: should be "package provide package ?version?"}} 630test pkg-3.18 {Tcl_PackageCmd procedure, "provide" option} { 631 list [catch {package provide a b c} msg] $msg 632} {1 {wrong # args: should be "package provide package ?version?"}} 633test pkg-3.19 {Tcl_PackageCmd procedure, "provide" option} { 634 package forget t 635 package provide t 636} {} 637test pkg-3.20 {Tcl_PackageCmd procedure, "provide" option} { 638 package forget t 639 package provide t 2.3 640 package provide t 641} {2.3} 642test pkg-3.21 {Tcl_PackageCmd procedure, "provide" option} { 643 package forget t 644 list [catch {package provide t a.b} msg] $msg 645} {1 {expected version number but got "a.b"}} 646test pkg-3.22 {Tcl_PackageCmd procedure, "require" option} { 647 list [catch {package require} msg] $msg 648} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}} 649 650test pkg-3.24 {Tcl_PackageCmd procedure, "require" option} { 651 list [catch {package require -exact a b c} msg] $msg 652 # Exact syntax: -exact name version 653 # name ?requirement...? 654} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}} 655 656test pkg-3.26 {Tcl_PackageCmd procedure, "require" option} { 657 list [catch {package require x a.b} msg] $msg 658} {1 {expected version number but got "a.b"}} 659test pkg-3.27 {Tcl_PackageCmd procedure, "require" option} { 660 list [catch {package require -exact x a.b} msg] $msg 661} {1 {expected version number but got "a.b"}} 662test pkg-3.28 {Tcl_PackageCmd procedure, "require" option} { 663 list [catch {package require -exact x} msg] $msg 664} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}} 665test pkg-3.29 {Tcl_PackageCmd procedure, "require" option} { 666 list [catch {package require -exact} msg] $msg 667} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}} 668test pkg-3.30 {Tcl_PackageCmd procedure, "require" option} { 669 package forget t 670 package provide t 2.3 671 package require t 2.1 672} {2.3} 673test pkg-3.31 {Tcl_PackageCmd procedure, "require" option} { 674 package forget t 675 list [catch {package require t} msg] $msg 676} {1 {can't find package t}} 677test pkg-3.32 {Tcl_PackageCmd procedure, "require" option} { 678 package forget t 679 package ifneeded t 2.3 "error {synthetic error}" 680 list [catch {package require t 2.3} msg] $msg 681} {1 {synthetic error}} 682test pkg-3.33 {Tcl_PackageCmd procedure, "unknown" option} { 683 list [catch {package unknown a b} msg] $msg 684} {1 {wrong # args: should be "package unknown ?command?"}} 685test pkg-3.34 {Tcl_PackageCmd procedure, "unknown" option} { 686 package unknown "test script" 687 package unknown 688} {test script} 689test pkg-3.35 {Tcl_PackageCmd procedure, "unknown" option} { 690 package unknown "test script" 691 package unknown {} 692 package unknown 693} {} 694test pkg-3.36 {Tcl_PackageCmd procedure, "vcompare" option} { 695 list [catch {package vcompare a} msg] $msg 696} {1 {wrong # args: should be "package vcompare version1 version2"}} 697test pkg-3.37 {Tcl_PackageCmd procedure, "vcompare" option} { 698 list [catch {package vcompare a b c} msg] $msg 699} {1 {wrong # args: should be "package vcompare version1 version2"}} 700test pkg-3.38 {Tcl_PackageCmd procedure, "vcompare" option} { 701 list [catch {package vcompare x.y 3.4} msg] $msg 702} {1 {expected version number but got "x.y"}} 703test pkg-3.39 {Tcl_PackageCmd procedure, "vcompare" option} { 704 list [catch {package vcompare 2.1 a.b} msg] $msg 705} {1 {expected version number but got "a.b"}} 706test pkg-3.40 {Tcl_PackageCmd procedure, "vcompare" option} { 707 package vc 2.1 2.3 708} {-1} 709test pkg-3.41 {Tcl_PackageCmd procedure, "vcompare" option} { 710 package vc 2.2.4 2.2.4 711} {0} 712test pkg-3.42 {Tcl_PackageCmd procedure, "versions" option} { 713 list [catch {package versions} msg] $msg 714} {1 {wrong # args: should be "package versions package"}} 715test pkg-3.43 {Tcl_PackageCmd procedure, "versions" option} { 716 list [catch {package versions a b} msg] $msg 717} {1 {wrong # args: should be "package versions package"}} 718test pkg-3.44 {Tcl_PackageCmd procedure, "versions" option} { 719 package forget t 720 package versions t 721} {} 722test pkg-3.45 {Tcl_PackageCmd procedure, "versions" option} { 723 package forget t 724 package provide t 2.3 725 package versions t 726} {} 727test pkg-3.46 {Tcl_PackageCmd procedure, "versions" option} { 728 package forget t 729 package ifneeded t 2.3 x 730 package ifneeded t 2.4 y 731 package versions t 732} {2.3 2.4} 733test pkg-3.47 {Tcl_PackageCmd procedure, "vsatisfies" option} { 734 list [catch {package vsatisfies a} msg] $msg 735} {1 {wrong # args: should be "package vsatisfies version requirement requirement..."}} 736 737test pkg-3.49 {Tcl_PackageCmd procedure, "vsatisfies" option} { 738 list [catch {package vsatisfies x.y 3.4} msg] $msg 739} {1 {expected version number but got "x.y"}} 740test pkg-3.50 {Tcl_PackageCmd procedure, "vsatisfies" option} { 741 list [catch {package vcompare 2.1 a.b} msg] $msg 742} {1 {expected version number but got "a.b"}} 743test pkg-3.51 {Tcl_PackageCmd procedure, "vsatisfies" option} { 744 package vs 2.3 2.1 745} {1} 746test pkg-3.52 {Tcl_PackageCmd procedure, "vsatisfies" option} { 747 package vs 2.3 1.2 748} {0} 749test pkg-3.53 {Tcl_PackageCmd procedure, "versions" option} { 750 list [catch {package foo} msg] $msg 751} {1 {bad option "foo": must be forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies}} 752 753test pkg-3.54 {Tcl_PackageCmd procedure, "vsatisfies" option} { 754 list [catch {package vsatisfies 2.1 2.1-3.2-4.5} msg] $msg 755} {1 {expected versionMin-versionMax but got "2.1-3.2-4.5"}} 756 757test pkg-3.55 {Tcl_PackageCmd procedure, "vsatisfies" option} { 758 list [catch {package vsatisfies 2.1 3.2-x.y} msg] $msg 759} {1 {expected version number but got "x.y"}} 760 761test pkg-3.56 {Tcl_PackageCmd procedure, "vsatisfies" option} { 762 list [catch {package vsatisfies 2.1 x.y-3.2} msg] $msg 763} {1 {expected version number but got "x.y"}} 764 765 766# No tests for FindPackage; can't think up anything detectable 767# errors. 768 769test pkg-4.1 {TclFreePackageInfo procedure} { 770 interp create foo 771 foo eval { 772 package ifneeded t 2.3 x 773 package ifneeded t 2.4 y 774 package ifneeded x 3.1 z 775 package provide q 4.3 776 package unknown "will this get freed?" 777 } 778 interp delete foo 779} {} 780test pkg-4.2 {TclFreePackageInfo procedure} -body { 781 interp create foo 782 foo eval { 783 package ifneeded t 2.3 x 784 package ifneeded t 2.4 y 785 package ifneeded x 3.1 z 786 package provide q 4.3 787 } 788 foo alias z kill 789 proc kill {} { 790 interp delete foo 791 } 792 foo eval package require x 3.1 793} -returnCodes error -match glob -result * 794 795test pkg-5.1 {CheckVersion procedure} { 796 list [catch {package vcompare 1 2.1} msg] $msg 797} {0 -1} 798test pkg-5.2 {CheckVersion procedure} { 799 list [catch {package vcompare .1 2.1} msg] $msg 800} {1 {expected version number but got ".1"}} 801test pkg-5.3 {CheckVersion procedure} { 802 list [catch {package vcompare 111.2a.3 2.1} msg] $msg 803} {1 {expected version number but got "111.2a.3"}} 804test pkg-5.4 {CheckVersion procedure} { 805 list [catch {package vcompare 1.2.3. 2.1} msg] $msg 806} {1 {expected version number but got "1.2.3."}} 807test pkg-5.5 {CheckVersion procedure} { 808 list [catch {package vcompare 1.2..3 2.1} msg] $msg 809} {1 {expected version number but got "1.2..3"}} 810 811test pkg-6.1 {ComparePkgVersions procedure} { 812 package vcompare 1.23 1.22 813} {1} 814test pkg-6.2 {ComparePkgVersions procedure} { 815 package vcompare 1.22.1.2.3 1.22.1.2.3 816} {0} 817test pkg-6.3 {ComparePkgVersions procedure} { 818 package vcompare 1.21 1.22 819} {-1} 820test pkg-6.4 {ComparePkgVersions procedure} { 821 package vcompare 1.21 1.21.2 822} {-1} 823test pkg-6.5 {ComparePkgVersions procedure} { 824 package vcompare 1.21.1 1.21 825} {1} 826test pkg-6.6 {ComparePkgVersions procedure} { 827 package vsatisfies 1.21.1 1.21 828} {1} 829test pkg-6.7 {ComparePkgVersions procedure} { 830 package vsatisfies 2.22.3 1.21 831} {0} 832test pkg-6.8 {ComparePkgVersions procedure} { 833 package vsatisfies 1 1 834} {1} 835test pkg-6.9 {ComparePkgVersions procedure} { 836 package vsatisfies 2 1 837} {0} 838 839test pkg-7.1 {Tcl_PkgPresent procedure, any version} { 840 package forget t 841 package provide t 2.4 842 package present t 843} {2.4} 844test pkg-7.2 {Tcl_PkgPresent procedure, correct version} { 845 package forget t 846 package provide t 2.4 847 package present t 2.4 848} {2.4} 849test pkg-7.3 {Tcl_PkgPresent procedure, satisfying version} { 850 package forget t 851 package provide t 2.4 852 package present t 2.0 853} {2.4} 854test pkg-7.4 {Tcl_PkgPresent procedure, not satisfying version} { 855 package forget t 856 package provide t 2.4 857 list [catch {package present t 2.6} msg] $msg 858} {1 {version conflict for package "t": have 2.4, need 2.6}} 859test pkg-7.5 {Tcl_PkgPresent procedure, not satisfying version} { 860 package forget t 861 package provide t 2.4 862 list [catch {package present t 1.0} msg] $msg 863} {1 {version conflict for package "t": have 2.4, need 1.0}} 864test pkg-7.6 {Tcl_PkgPresent procedure, exact version} { 865 package forget t 866 package provide t 2.4 867 package present -exact t 2.4 868} {2.4} 869test pkg-7.7 {Tcl_PkgPresent procedure, not exact version} { 870 package forget t 871 package provide t 2.4 872 list [catch {package present -exact t 2.3} msg] $msg 873} {1 {version conflict for package "t": have 2.4, need exactly 2.3}} 874test pkg-7.8 {Tcl_PkgPresent procedure, unknown package} { 875 package forget t 876 list [catch {package present t} msg] $msg 877} {1 {package t is not present}} 878test pkg-7.9 {Tcl_PkgPresent procedure, unknown package} { 879 package forget t 880 list [catch {package present t 2.4} msg] $msg 881} {1 {package t 2.4 is not present}} 882test pkg-7.10 {Tcl_PkgPresent procedure, unknown package} { 883 package forget t 884 list [catch {package present -exact t 2.4} msg] $msg 885} {1 {package t 2.4 is not present}} 886test pkg-7.11 {Tcl_PackageCmd procedure, "present" option} { 887 list [catch {package present} msg] $msg 888} {1 {wrong # args: should be "package present ?-exact? package ?requirement...?"}} 889test pkg-7.12 {Tcl_PackageCmd procedure, "present" option} { 890 list [catch {package present a b c} msg] $msg 891} {1 {expected version number but got "b"}} 892test pkg-7.13 {Tcl_PackageCmd procedure, "present" option} { 893 list [catch {package present -exact a b c} msg] $msg 894} {1 {wrong # args: should be "package present ?-exact? package ?requirement...?"}} 895test pkg-7.14 {Tcl_PackageCmd procedure, "present" option} { 896 list [catch {package present -bs a b} msg] $msg 897} {1 {expected version number but got "a"}} 898test pkg-7.15 {Tcl_PackageCmd procedure, "present" option} { 899 list [catch {package present x a.b} msg] $msg 900} {1 {expected version number but got "a.b"}} 901test pkg-7.16 {Tcl_PackageCmd procedure, "present" option} { 902 list [catch {package present -exact x a.b} msg] $msg 903} {1 {expected version number but got "a.b"}} 904test pkg-7.17 {Tcl_PackageCmd procedure, "present" option} { 905 list [catch {package present -exact x} msg] $msg 906} {1 {wrong # args: should be "package present ?-exact? package ?requirement...?"}} 907test pkg-7.18 {Tcl_PackageCmd procedure, "present" option} { 908 list [catch {package present -exact} msg] $msg 909} {1 {wrong # args: should be "package present ?-exact? package ?requirement...?"}} 910 911 912 913 914set n 0 915foreach {r p vs vc} { 916 8.5a0 8.5a5 1 -1 917 8.5a0 8.5b1 1 -1 918 8.5a0 8.5.1 1 -1 919 8.5a0 8.6a0 1 -1 920 8.5a0 8.6b0 1 -1 921 8.5a0 8.6.0 1 -1 922 8.5a6 8.5a5 0 1 923 8.5a6 8.5b1 1 -1 924 8.5a6 8.5.1 1 -1 925 8.5a6 8.6a0 1 -1 926 8.5a6 8.6b0 1 -1 927 8.5a6 8.6.0 1 -1 928 8.5b0 8.5a5 0 1 929 8.5b0 8.5b1 1 -1 930 8.5b0 8.5.1 1 -1 931 8.5b0 8.6a0 1 -1 932 8.5b0 8.6b0 1 -1 933 8.5b0 8.6.0 1 -1 934 8.5b2 8.5a5 0 1 935 8.5b2 8.5b1 0 1 936 8.5b2 8.5.1 1 -1 937 8.5b2 8.6a0 1 -1 938 8.5b2 8.6b0 1 -1 939 8.5b2 8.6.0 1 -1 940 8.5 8.5a5 1 1 941 8.5 8.5b1 1 1 942 8.5 8.5.1 1 -1 943 8.5 8.6a0 1 -1 944 8.5 8.6b0 1 -1 945 8.5 8.6.0 1 -1 946 8.5.0 8.5a5 0 1 947 8.5.0 8.5b1 0 1 948 8.5.0 8.5.1 1 -1 949 8.5.0 8.6a0 1 -1 950 8.5.0 8.6b0 1 -1 951 8.5.0 8.6.0 1 -1 952 10 8 0 1 953 8 10 0 -1 954 0.0.1.2 0.1.2 1 -1 955} { 956 test package-vsatisfies-1.$n {package vsatisfies} { 957 package vsatisfies $p $r 958 } $vs 959 960 test package-vcompare-1.$n {package vcompare} { 961 package vcompare $r $p 962 } $vc 963 964 incr n 965} 966 967test package-vcompare-2.0 {package vcompare at 32bit boundary} { 968 package vcompare [expr {1<<31}] [expr {(1<<31)-1}] 969} 1 970 971# Note: It is correct that the result of the very first test, 972# i.e. "5.0 5.0a0" is 1, i.e. that version 5.0a0 satisfies a 5.0 973# requirement. 974 975# The requirement "5.0" internally translates first to "5.0-6", and 976# then to its final form of "5.0a0-6a0". These translations are 977# explicitly specified by the TIP (Search for "padded/extended 978# internally with 'a0'"). This was done intentionally for exactly the 979# tested case, that an alpha package can satisfy a requirement for the 980# regular package. An example would be a package FOO requiring Tcl 8.X 981# for its operation. It can be used with Tcl 8.Xa0. Without our 982# translation that would not be possible. 983 984set n 0 985foreach {required provided satisfied} { 986 5.0 5.0a0 1 987 5.0a0 5.0 1 988 989 8.5a0- 8.5a5 1 990 8.5a0- 8.5b1 1 991 8.5a0- 8.5.1 1 992 8.5a0- 8.6a0 1 993 8.5a0- 8.6b0 1 994 8.5a0- 8.6.0 1 995 8.5a6- 8.5a5 0 996 8.5a6- 8.5b1 1 997 8.5a6- 8.5.1 1 998 8.5a6- 8.6a0 1 999 8.5a6- 8.6b0 1 1000 8.5a6- 8.6.0 1 1001 8.5b0- 8.5a5 0 1002 8.5b0- 8.5b1 1 1003 8.5b0- 8.5.1 1 1004 8.5b0- 8.6a0 1 1005 8.5b0- 8.6b0 1 1006 8.5b0- 8.6.0 1 1007 8.5b2- 8.5a5 0 1008 8.5b2- 8.5b1 0 1009 8.5b2- 8.5.1 1 1010 8.5b2- 8.6a0 1 1011 8.5b2- 8.6b0 1 1012 8.5b2- 8.6.0 1 1013 8.5- 8.5a5 1 1014 8.5- 8.5b1 1 1015 8.5- 8.5.1 1 1016 8.5- 8.6a0 1 1017 8.5- 8.6b0 1 1018 8.5- 8.6.0 1 1019 8.5.0- 8.5a5 0 1020 8.5.0- 8.5b1 0 1021 8.5.0- 8.5.1 1 1022 8.5.0- 8.6a0 1 1023 8.5.0- 8.6b0 1 1024 8.5.0- 8.6.0 1 1025 8.5a0-7 8.5a5 0 1026 8.5a0-7 8.5b1 0 1027 8.5a0-7 8.5.1 0 1028 8.5a0-7 8.6a0 0 1029 8.5a0-7 8.6b0 0 1030 8.5a0-7 8.6.0 0 1031 8.5a6-7 8.5a5 0 1032 8.5a6-7 8.5b1 0 1033 8.5a6-7 8.5.1 0 1034 8.5a6-7 8.6a0 0 1035 8.5a6-7 8.6b0 0 1036 8.5a6-7 8.6.0 0 1037 8.5b0-7 8.5a5 0 1038 8.5b0-7 8.5b1 0 1039 8.5b0-7 8.5.1 0 1040 8.5b0-7 8.6a0 0 1041 8.5b0-7 8.6b0 0 1042 8.5b0-7 8.6.0 0 1043 8.5b2-7 8.5a5 0 1044 8.5b2-7 8.5b1 0 1045 8.5b2-7 8.5.1 0 1046 8.5b2-7 8.6a0 0 1047 8.5b2-7 8.6b0 0 1048 8.5b2-7 8.6.0 0 1049 8.5-7 8.5a5 0 1050 8.5-7 8.5b1 0 1051 8.5-7 8.5.1 0 1052 8.5-7 8.6a0 0 1053 8.5-7 8.6b0 0 1054 8.5-7 8.6.0 0 1055 8.5.0-7 8.5a5 0 1056 8.5.0-7 8.5b1 0 1057 8.5.0-7 8.5.1 0 1058 8.5.0-7 8.6a0 0 1059 8.5.0-7 8.6b0 0 1060 8.5.0-7 8.6.0 0 1061 8.5a0-8.6.1 8.5a5 1 1062 8.5a0-8.6.1 8.5b1 1 1063 8.5a0-8.6.1 8.5.1 1 1064 8.5a0-8.6.1 8.6a0 1 1065 8.5a0-8.6.1 8.6b0 1 1066 8.5a0-8.6.1 8.6.0 1 1067 8.5a6-8.6.1 8.5a5 0 1068 8.5a6-8.6.1 8.5b1 1 1069 8.5a6-8.6.1 8.5.1 1 1070 8.5a6-8.6.1 8.6a0 1 1071 8.5a6-8.6.1 8.6b0 1 1072 8.5a6-8.6.1 8.6.0 1 1073 8.5b0-8.6.1 8.5a5 0 1074 8.5b0-8.6.1 8.5b1 1 1075 8.5b0-8.6.1 8.5.1 1 1076 8.5b0-8.6.1 8.6a0 1 1077 8.5b0-8.6.1 8.6b0 1 1078 8.5b0-8.6.1 8.6.0 1 1079 8.5b2-8.6.1 8.5a5 0 1080 8.5b2-8.6.1 8.5b1 0 1081 8.5b2-8.6.1 8.5.1 1 1082 8.5b2-8.6.1 8.6a0 1 1083 8.5b2-8.6.1 8.6b0 1 1084 8.5b2-8.6.1 8.6.0 1 1085 8.5-8.6.1 8.5a5 1 1086 8.5-8.6.1 8.5b1 1 1087 8.5-8.6.1 8.5.1 1 1088 8.5-8.6.1 8.6a0 1 1089 8.5-8.6.1 8.6b0 1 1090 8.5-8.6.1 8.6.0 1 1091 8.5.0-8.6.1 8.5a5 0 1092 8.5.0-8.6.1 8.5b1 0 1093 8.5.0-8.6.1 8.5.1 1 1094 8.5.0-8.6.1 8.6a0 1 1095 8.5.0-8.6.1 8.6b0 1 1096 8.5.0-8.6.1 8.6.0 1 1097 8.5a0-8.5a0 8.5a0 1 1098 8.5a0-8.5a0 8.5b1 0 1099 8.5a0-8.5a0 8.4 0 1100 8.5b0-8.5b0 8.5a5 0 1101 8.5b0-8.5b0 8.5b0 1 1102 8.5b0-8.5b0 8.5.1 0 1103 8.5-8.5 8.5a5 0 1104 8.5-8.5 8.5b1 0 1105 8.5-8.5 8.5 1 1106 8.5-8.5 8.5.1 0 1107 8.5.0-8.5.0 8.5a5 0 1108 8.5.0-8.5.0 8.5b1 0 1109 8.5.0-8.5.0 8.5.0 1 1110 8.5.0-8.5.0 8.5.1 0 1111 8.5.0-8.5.0 8.6a0 0 1112 8.5.0-8.5.0 8.6b0 0 1113 8.5.0-8.5.0 8.6.0 0 1114 8.2 9 0 1115 8.2- 9 1 1116 8.2-8.5 9 0 1117 8.2-9.1 9 1 1118 1119 8.5-8.5 8.5b1 0 1120 8.5a0-8.5 8.5b1 0 1121 8.5a0-8.5.1 8.5b1 1 1122 1123 8.5-8.5 8.5 1 1124 8.5.0-8.5.0 8.5 1 1125 8.5a0-8.5.0 8.5 0 1126 1127} { 1128 test package-vsatisfies-2.$n "package vsatisfies $provided $required" { 1129 package vsatisfies $provided $required 1130 } $satisfied 1131 incr n 1132} 1133 1134test package-vsatisfies-3.0 "package vsatisfies multiple" { 1135 # yes no 1136 package vsatisfies 8.4 8.4 7.3 1137} 1 1138 1139test package-vsatisfies-3.1 "package vsatisfies multiple" { 1140 # no yes 1141 package vsatisfies 8.4 7.3 8.4 1142} 1 1143 1144test package-vsatisfies-3.2 "package vsatisfies multiple" { 1145 # yes yes 1146 package vsatisfies 8.4.2 8.4 8.4.1 1147} 1 1148 1149test package-vsatisfies-3.3 "package vsatisfies multiple" { 1150 # no no 1151 package vsatisfies 8.4 7.3 6.1 1152} 0 1153 1154 1155proc prefer {args} { 1156 set ip [interp create] 1157 lappend res [$ip eval {package prefer}] 1158 foreach mode $args { 1159 lappend res [$ip eval [list package prefer $mode]] 1160 } 1161 interp delete $ip 1162 return $res 1163} 1164 1165test package-prefer-1.0 {default} { 1166 prefer 1167} stable 1168 1169test package-prefer-1.1 {default} { 1170 set ::env(TCL_PKG_PREFER_LATEST) stable ; # value not relevant! 1171 set res [prefer] 1172 unset ::env(TCL_PKG_PREFER_LATEST) 1173 set res 1174} latest 1175 1176test package-prefer-2.0 {wrong\#args} { 1177 catch {package prefer foo bar} msg 1178 set msg 1179} {wrong # args: should be "package prefer ?latest|stable?"} 1180 1181test package-prefer-2.1 {bogus argument} { 1182 catch {package prefer foo} msg 1183 set msg 1184} {bad preference "foo": must be latest or stable} 1185 1186test package-prefer-3.0 {set, keep} { 1187 package prefer stable 1188} stable 1189 1190test package-prefer-3.1 {set stable, keep} { 1191 prefer stable 1192} {stable stable} 1193 1194test package-prefer-3.2 {set latest, change} { 1195 prefer latest 1196} {stable latest} 1197 1198test package-prefer-3.3 {set latest, keep} { 1199 prefer latest latest 1200} {stable latest latest} 1201 1202test package-prefer-3.4 {set stable, rejected} { 1203 prefer latest stable 1204} {stable latest latest} 1205 1206rename prefer {} 1207 1208 1209set auto_path $oldPath 1210package unknown $oldPkgUnknown 1211concat 1212 1213cleanupTests 1214} 1215 1216# cleanup 1217interp delete $i 1218::tcltest::cleanupTests 1219return 1220