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