pkg.test
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:43k
源码类别:

通讯编程

开发平台:

Visual C++

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