Tcl Source Code

Check-in [1830f9f520]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Repair lost of broken [package prefer] testing.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-branch
Files: files | file ages | folders
SHA3-256:1830f9f520e2abdd94f1d8e5e0ee01088ff7bcbcf05e0b48701ab6e23fe9433d
User & Date: dgp 2017-11-14 17:09:49
References
2018-07-10
08:19
amend to [1830f9f520e2abdd], fixed package.test if built without test - avoids test file error: pack... check-in: 55e4fbd950 user: sebres tags: core-8-branch
2018-07-09
19:24
amend to [1830f9f520e2abdd], fixed package.test if built without test - avoids test file error: pack... check-in: 24cfef99b2 user: sebres tags: trunk
Context
2017-11-15
08:55
Change signature of (internal) TclScanElement() function. This saves memory allocation and the possi... check-in: 1019b4d815 user: jan.nijtmans tags: core-8-branch
2017-11-14
18:52
merge 8.7 check-in: 673e6ace67 user: dgp tags: tip-445
18:19
merge 8.7 check-in: ccd961edbd user: dgp tags: no-wideint
17:24
[5d6de65036] [package require] with [package prefer stable] was not choosing available stable packag... check-in: 42eaa6f3d1 user: dgp tags: trunk
17:09
Repair lost of broken [package prefer] testing. check-in: 1830f9f520 user: dgp tags: core-8-branch
14:48
[5d6de65036] [package require] with [package prefer stable] was not choosing available stable packag... check-in: dc94155e2d user: dgp tags: core-8-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/package.test.

16
17
18
19
20
21
22
23
24
25
26
27

28
29
30
31
32
33
34


35
36
37
38
39
40
41
...
571
572
573
574
575
576
577



578
579
580

581

582
583
584
585
586



587
588
589
590
591
592
593
...
617
618
619
620
621
622
623
624



625
626
627




628



629
630
631




632


633
634

635

636
637
638
639
640
641



642
643


644

645

646
647
648
649
650
651
652



653
654
655
656
657
658
659
...
664
665
666
667
668
669
670
671



672
673



674
675


676

677

678
679



680
681


682

683

684
685



686
687


688

689

690
691
692



693
694
695
696
697
698
699
700
701
702
703
704
705



706
707
708




709


710

711

712
713
714
715
716



717
718
719
720
721
722
723
....
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258

1259
1260
1261
1262
1263
1264
1265
....
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285

1286
1287
1288
1289
1290

1291
1292
1293
1294
1295
1296
1297
1298
    package require tcltest 2.3.3
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testpreferstable [llength [info commands testpreferstable]]

# Do all this in a slave interp to avoid garbaging the package list
set i [interp create]
tcltest::loadIntoSlaveInterpreter $i {*}$argv

interp eval $i {
namespace import -force ::tcltest::*
package forget {*}[package names]
set oldPkgUnknown [package unknown]
package unknown {}
set oldPath $auto_path
set auto_path ""


 
test package-1.1 {pkg::create gives error on insufficient args} -body {
    ::pkg::create
} -returnCodes error -match glob -result {wrong # args: should be "*"}
test package-1.2 {pkg::create gives error on bad args} -body {
    ::pkg::create -foo bar -bar baz -baz boo
} -returnCodes error -match glob -result {unknown option "bar": *}
................................................................................
    package provide demo 1.2.3
} -body {
    package require -exact demo 1.2
} -returnCodes error -cleanup {
    package forget demo
} -result {version conflict for package "demo": have 1.2.3, need exactly 1.2}
test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -constraints testpreferstable -setup {



    testpreferstable
    package forget t
    set x xxx

} -body {

    foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t
    set x



} -result {3.4}
test package-3.51 {Tcl_PkgRequire procedure, picking best stable version} -setup {
    package forget t
    set x xxx
} -body {
    foreach i {1.2b1 1.2 1.3a2 1.3} {
	package ifneeded t $i "set x $i; package provide t $i"
................................................................................
    set x
} -result {1.1}


test package-4.1 {Tcl_PackageCmd procedure} -returnCodes error -body {
    package
} -result {wrong # args: should be "package option ?arg ...?"}
test package-4.2 {Tcl_PackageCmd procedure, "forget" option} {



    package forget {*}[package names]
    package names
} {}




test package-4.3 {Tcl_PackageCmd procedure, "forget" option} {



    package forget {*}[package names]
    package forget foo
} {}




test package-4.4 {Tcl_PackageCmd procedure, "forget" option} -setup {


    package forget {*}[package names]
    set result {}

} -body {

    package ifneeded t 1.1 {first script}
    package ifneeded t 2.3 {second script}
    package ifneeded x 1.4 {x's script}
    lappend result [lsort [package names]] [package versions t]
    package forget t
    lappend result [lsort [package names]] [package versions t]



} -result {{t x} {1.1 2.3} x {}}
test package-4.5 {Tcl_PackageCmd procedure, "forget" option} -setup {


    package forget {*}[package names]

} -body {

    package ifneeded a 1.1 {first script}
    package ifneeded b 2.3 {second script}
    package ifneeded c 1.4 {third script}
    package forget
    set result [list [lsort [package names]]]
    package forget a c
    lappend result [lsort [package names]]



} -result {{a b c} b}
test package-4.5.1 {Tcl_PackageCmd procedure, "forget" option} -body {
    # Test for Bug 415273
    package ifneeded a 1 "I should have been forgotten"
    package forget no-such-package a
    package ifneeded a 1
} -cleanup {
................................................................................
} -returnCodes error -result {wrong # args: should be "package ifneeded package version ?script?"}
test package-4.7 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
    package ifneeded a b c d
} -returnCodes error -result {wrong # args: should be "package ifneeded package version ?script?"}
test package-4.8 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
    package ifneeded t xyz
} -returnCodes error -result {expected version number but got "xyz"}
test package-4.9 {Tcl_PackageCmd procedure, "ifneeded" option} {



    package forget {*}[package names]
    list [package ifneeded foo 1.1] [package names]



} {{} {}}
test package-4.10 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {


    package forget t

} -body {

    package ifneeded t 1.4 "script for t 1.4"
    list [package names] [package ifneeded t 1.4] [package versions t]



} -result {t {script for t 1.4} 1.4}
test package-4.11 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {


    package forget t

} -body {

    package ifneeded t 1.4 "script for t 1.4"
    list [package ifneeded t 1.5] [package names] [package versions t]



} -result {{} t 1.4}
test package-4.12 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {


    package forget t

} -body {

    package ifneeded t 1.4 "script for t 1.4"
    package ifneeded t 1.4 "second script for t 1.4"
    list [package ifneeded t 1.4] [package names] [package versions t]



} -result {{second script for t 1.4} t 1.4}
test package-4.13 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
    package forget t
} -body {
    package ifneeded t 1.4 "script for t 1.4"
    package ifneeded t 1.2 "second script"
    package ifneeded t 3.1 "last script"
    list [package ifneeded t 1.2] [package versions t]
} -result {{second script} {1.4 1.2 3.1}}
test package-4.14 {Tcl_PackageCmd procedure, "names" option} -body {
    package names a
} -returnCodes error -result {wrong # args: should be "package names"}
test package-4.15 {Tcl_PackageCmd procedure, "names" option} {



    package forget {*}[package names]
    package names
} {}




test package-4.16 {Tcl_PackageCmd procedure, "names" option} -setup {


    package forget {*}[package names]

} -body {

    package ifneeded x 1.2 {dummy}
    package provide x 1.3
    package provide y 2.4
    catch {package require z 47.16}
    lsort [package names]



} -result {x y}
test package-4.17 {Tcl_PackageCmd procedure, "provide" option} -body {
    package provide
} -returnCodes error -result {wrong # args: should be "package provide package ?version?"}
test package-4.18 {Tcl_PackageCmd procedure, "provide" option} -body {
    package provide a b c
} -returnCodes error -result {wrong # args: should be "package provide package ?version?"}
................................................................................
	}
	return $res
    } finally {
	interp delete $ip
    }
}

test package-13.0 {package prefer defaults} -constraints testpreferstable -setup {
    testpreferstable
} -body {
    prefer
} -result stable

test package-13.1 {package prefer defaults} -body {
    set ::env(TCL_PKG_PREFER_LATEST) stable	;# value not relevant!
    prefer
} -cleanup {
    unset -nocomplain ::env(TCL_PKG_PREFER_LATEST)
} -result latest

................................................................................
} -result {wrong # args: should be "package prefer ?latest|stable?"}
test package-14.1 {bogus argument} -returnCodes error -body {
    package prefer foo
} -result {bad preference "foo": must be latest or stable}

test package-15.0 {set, keep} -constraints testpreferstable -setup {
    testpreferstable
} -body {package prefer stable} -result stable
test package-15.1 {set stable, keep} -constraints testpreferstable -setup {
    testpreferstable
} -body {prefer stable} -result {stable stable}
test package-15.2 {set latest, change} -constraints testpreferstable -setup {
    testpreferstable
} -body {prefer latest} -result {stable latest}
test package-15.3 {set latest, keep} -constraints testpreferstable -setup {
    testpreferstable
} -body {
    prefer latest latest

} -result {stable latest latest}
test package-15.4 {set stable, rejected} -constraints testpreferstable -setup {
    testpreferstable
} -body {
    prefer latest stable

} -result {stable latest latest}

rename prefer {}
 
set auto_path $oldPath
package unknown $oldPkgUnknown

cleanupTests







<
<



>


|




>
>







 







>
>
>



>

>





>
>
>







 







|
>
>
>


<
>
>
>
>
|
>
>
>


<
>
>
>
>

>
>


>

>






>
>
>


>
>

>

>







>
>
>







 







|
>
>
>


>
>
>
|

>
>
|
>

>


>
>
>


>
>
|
>

>


>
>
>


>
>
|
>

>



>
>
>












|
>
>
>


<
>
>
>
>

>
>

>

>





>
>
>







 







|
<
<

<
>







 







|


|


|



|
>
|



|
>
|







16
17
18
19
20
21
22


23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
...
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
...
626
627
628
629
630
631
632
633
634
635
636
637
638

639
640
641
642
643
644
645
646
647
648

649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
...
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772

773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
....
1322
1323
1324
1325
1326
1327
1328
1329


1330

1331
1332
1333
1334
1335
1336
1337
1338
....
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
    package require tcltest 2.3.3
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]



# Do all this in a slave interp to avoid garbaging the package list
set i [interp create]
tcltest::loadIntoSlaveInterpreter $i {*}$argv
load {} Tcltest $i
interp eval $i {
namespace import -force ::tcltest::*
#package forget {*}[package names]
set oldPkgUnknown [package unknown]
package unknown {}
set oldPath $auto_path
set auto_path ""

testConstraint testpreferstable [llength [info commands testpreferstable]]
 
test package-1.1 {pkg::create gives error on insufficient args} -body {
    ::pkg::create
} -returnCodes error -match glob -result {wrong # args: should be "*"}
test package-1.2 {pkg::create gives error on bad args} -body {
    ::pkg::create -foo bar -bar baz -baz boo
} -returnCodes error -match glob -result {unknown option "bar": *}
................................................................................
    package provide demo 1.2.3
} -body {
    package require -exact demo 1.2
} -returnCodes error -cleanup {
    package forget demo
} -result {version conflict for package "demo": have 1.2.3, need exactly 1.2}
test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -constraints testpreferstable -setup {
    interp create child
    load {} Tcltest child
    child eval {
    testpreferstable
    package forget t
    set x xxx
    }
} -body {
    child eval {
    foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t
    set x
    }
} -cleanup {
    interp delete child
} -result {3.4}
test package-3.51 {Tcl_PkgRequire procedure, picking best stable version} -setup {
    package forget t
    set x xxx
} -body {
    foreach i {1.2b1 1.2 1.3a2 1.3} {
	package ifneeded t $i "set x $i; package provide t $i"
................................................................................
    set x
} -result {1.1}


test package-4.1 {Tcl_PackageCmd procedure} -returnCodes error -body {
    package
} -result {wrong # args: should be "package option ?arg ...?"}
test package-4.2 {Tcl_PackageCmd procedure, "forget" option} -setup {
    interp create child
} -body {
    child eval {
    package forget {*}[package names]
    package names

    }
} -cleanup {
    interp delete child
} -result {}
test package-4.3 {Tcl_PackageCmd procedure, "forget" option} -setup {
    interp create child
} -body {
    child eval {
    package forget {*}[package names]
    package forget foo

    }
} -cleanup {
    interp delete child
} -result {}
test package-4.4 {Tcl_PackageCmd procedure, "forget" option} -setup {
    interp create child
    child eval {
    package forget {*}[package names]
    set result {}
    }
} -body {
    child eval {
    package ifneeded t 1.1 {first script}
    package ifneeded t 2.3 {second script}
    package ifneeded x 1.4 {x's script}
    lappend result [lsort [package names]] [package versions t]
    package forget t
    lappend result [lsort [package names]] [package versions t]
    }
} -cleanup {
    interp delete child
} -result {{t x} {1.1 2.3} x {}}
test package-4.5 {Tcl_PackageCmd procedure, "forget" option} -setup {
    interp create child
    child eval {
    package forget {*}[package names]
    }
} -body {
    child eval {
    package ifneeded a 1.1 {first script}
    package ifneeded b 2.3 {second script}
    package ifneeded c 1.4 {third script}
    package forget
    set result [list [lsort [package names]]]
    package forget a c
    lappend result [lsort [package names]]
    }
} -cleanup {
    interp delete child
} -result {{a b c} b}
test package-4.5.1 {Tcl_PackageCmd procedure, "forget" option} -body {
    # Test for Bug 415273
    package ifneeded a 1 "I should have been forgotten"
    package forget no-such-package a
    package ifneeded a 1
} -cleanup {
................................................................................
} -returnCodes error -result {wrong # args: should be "package ifneeded package version ?script?"}
test package-4.7 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
    package ifneeded a b c d
} -returnCodes error -result {wrong # args: should be "package ifneeded package version ?script?"}
test package-4.8 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
    package ifneeded t xyz
} -returnCodes error -result {expected version number but got "xyz"}
test package-4.9 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
    interp create child
} -body {
    child eval {
    package forget {*}[package names]
    list [package ifneeded foo 1.1] [package names]
    }
} -cleanup {
    interp delete child
} -result {{} {}}
test package-4.10 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
    interp create child
    child eval {
    package forget {*}[package names]
    }
} -body {
    child eval {
    package ifneeded t 1.4 "script for t 1.4"
    list [package names] [package ifneeded t 1.4] [package versions t]
    }
} -cleanup {
    interp delete child
} -result {t {script for t 1.4} 1.4}
test package-4.11 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
    interp create child
    child eval {
    package forget {*}[package names]
    }
} -body {
    child eval {
    package ifneeded t 1.4 "script for t 1.4"
    list [package ifneeded t 1.5] [package names] [package versions t]
    }
} -cleanup {
    interp delete child
} -result {{} t 1.4}
test package-4.12 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
    interp create child
    child eval {
    package forget {*}[package names]
    }
} -body {
    child eval {
    package ifneeded t 1.4 "script for t 1.4"
    package ifneeded t 1.4 "second script for t 1.4"
    list [package ifneeded t 1.4] [package names] [package versions t]
    }
} -cleanup {
    interp delete child
} -result {{second script for t 1.4} t 1.4}
test package-4.13 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
    package forget t
} -body {
    package ifneeded t 1.4 "script for t 1.4"
    package ifneeded t 1.2 "second script"
    package ifneeded t 3.1 "last script"
    list [package ifneeded t 1.2] [package versions t]
} -result {{second script} {1.4 1.2 3.1}}
test package-4.14 {Tcl_PackageCmd procedure, "names" option} -body {
    package names a
} -returnCodes error -result {wrong # args: should be "package names"}
test package-4.15 {Tcl_PackageCmd procedure, "names" option} -setup {
    interp create child
} -body {
    child eval {
    package forget {*}[package names]
    package names

    }
} -cleanup {
    interp delete child
} -result {}
test package-4.16 {Tcl_PackageCmd procedure, "names" option} -setup {
    interp create child
    child eval {
    package forget {*}[package names]
    }
} -body {
    child eval {
    package ifneeded x 1.2 {dummy}
    package provide x 1.3
    package provide y 2.4
    catch {package require z 47.16}
    lsort [package names]
    }
} -cleanup {
    interp delete child
} -result {x y}
test package-4.17 {Tcl_PackageCmd procedure, "provide" option} -body {
    package provide
} -returnCodes error -result {wrong # args: should be "package provide package ?version?"}
test package-4.18 {Tcl_PackageCmd procedure, "provide" option} -body {
    package provide a b c
} -returnCodes error -result {wrong # args: should be "package provide package ?version?"}
................................................................................
	}
	return $res
    } finally {
	interp delete $ip
    }
}

test package-13.0 {package prefer defaults} -body {


    prefer

} -result [expr {[string match {*[ab]*} [package provide Tcl]] ? "latest" : "stable"}]
test package-13.1 {package prefer defaults} -body {
    set ::env(TCL_PKG_PREFER_LATEST) stable	;# value not relevant!
    prefer
} -cleanup {
    unset -nocomplain ::env(TCL_PKG_PREFER_LATEST)
} -result latest

................................................................................
} -result {wrong # args: should be "package prefer ?latest|stable?"}
test package-14.1 {bogus argument} -returnCodes error -body {
    package prefer foo
} -result {bad preference "foo": must be latest or stable}

test package-15.0 {set, keep} -constraints testpreferstable -setup {
    testpreferstable
} -body {package prefer} -result stable
test package-15.1 {set stable, keep} -constraints testpreferstable -setup {
    testpreferstable
} -body {package prefer stable} -result stable
test package-15.2 {set latest, change} -constraints testpreferstable -setup {
    testpreferstable
} -body {package prefer latest} -result latest
test package-15.3 {set latest, keep} -constraints testpreferstable -setup {
    testpreferstable
} -body {
    package prefer latest
    package prefer latest
} -result latest
test package-15.4 {set stable, rejected} -constraints testpreferstable -setup {
    testpreferstable
} -body {
    package prefer latest
    package prefer stable
} -result latest

rename prefer {}
 
set auto_path $oldPath
package unknown $oldPkgUnknown

cleanupTests