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