diff options
Diffstat (limited to 'tests/load.test')
| -rw-r--r-- | tests/load.test | 133 |
1 files changed, 72 insertions, 61 deletions
diff --git a/tests/load.test b/tests/load.test index db2d073..bd480b9 100644 --- a/tests/load.test +++ b/tests/load.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: load.test,v 1.10 2002/06/22 04:19:47 dgp Exp $ +# RCS: @(#) $Id: load.test,v 1.11 2003/02/01 23:37:29 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -41,22 +41,28 @@ set alreadyLoaded [info loaded] set alreadyTotalLoaded [info loaded] -test load-1.1 {basic errors} [list $dll $loaded] { +# Certain tests require the 'teststaticpkg' command from tcltest + +::tcltest::testConstraint teststaticpkg \ + [string compare {} [info commands teststaticpkg]] + + +test load-1.1 {basic errors} {} { list [catch {load} msg] $msg -} {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}} -test load-1.2 {basic errors} [list $dll $loaded] { +} "1 {wrong \# args: should be \"load fileName ?packageName? ?interp?\"}" +test load-1.2 {basic errors} {} { list [catch {load a b c d} msg] $msg -} {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}} -test load-1.3 {basic errors} [list $dll $loaded] { +} "1 {wrong \# args: should be \"load fileName ?packageName? ?interp?\"}" +test load-1.3 {basic errors} {} { list [catch {load a b foobar} msg] $msg } {1 {could not find interpreter "foobar"}} -test load-1.4 {basic errors} [list $dll $loaded] { +test load-1.4 {basic errors} {} { list [catch {load {}} msg] $msg } {1 {must specify either file name or package name}} -test load-1.5 {basic errors} [list $dll $loaded] { +test load-1.5 {basic errors} {} { list [catch {load {} {}} msg] $msg } {1 {must specify either file name or package name}} -test load-1.6 {basic errors} [list $dll $loaded] { +test load-1.6 {basic errors} {} { list [catch {load {} Unknown} msg] $msg } {1 {package "Unknown" isn't loaded statically}} @@ -133,63 +139,68 @@ test load-6.1 {errors loading file} [list $dll $loaded nonPortable] { catch {load foo foo} } {1} -if {[info command teststaticpkg] != ""} { - test load-7.1 {Tcl_StaticPackage procedure} [list $dll $loaded] { - set x "not loaded" - teststaticpkg Test 1 0 - load {} Test - load {} Test child - list [set x] [child eval set x] - } {loaded loaded} - test load-7.2 {Tcl_StaticPackage procedure} [list $dll $loaded] { - set x "not loaded" - teststaticpkg Another 0 0 - load {} Another - child eval {set x "not loaded"} - list [catch {load {} Another child} msg] $msg \ - [child eval set x] [set x] - } {1 {can't use package in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded} - test load-7.3 {Tcl_StaticPackage procedure} [list $dll $loaded] { - set x "not loaded" - teststaticpkg More 0 1 - load {} More - set x - } {not loaded} - test load-7.4 {Tcl_StaticPackage procedure, redundant calls} \ - [list $dll $loaded] { +test load-7.1 {Tcl_StaticPackage procedure} [list teststaticpkg] { + set x "not loaded" + teststaticpkg Test 1 0 + load {} Test + load {} Test child + list [set x] [child eval set x] +} {loaded loaded} +test load-7.2 {Tcl_StaticPackage procedure} [list teststaticpkg] { + set x "not loaded" + teststaticpkg Another 0 0 + load {} Another + child eval {set x "not loaded"} + list [catch {load {} Another child} msg] $msg \ + [child eval set x] [set x] +} {1 {can't use package in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded} +test load-7.3 {Tcl_StaticPackage procedure} [list teststaticpkg] { + set x "not loaded" + teststaticpkg More 0 1 + load {} More + set x +} {not loaded} +test load-7.4 {Tcl_StaticPackage procedure, redundant calls} \ + [list teststaticpkg $dll $loaded] { teststaticpkg Double 0 1 teststaticpkg Double 0 1 info loaded } [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded] - test load-8.1 {TclGetLoadedPackages procedure} [list $dll $loaded] { - info loaded - } [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded] - test load-8.2 {TclGetLoadedPackages procedure} [list $dll $loaded] { - list [catch {info loaded gorp} msg] $msg - } {1 {could not find interpreter "gorp"}} - test load-8.3 {TclGetLoadedPackages procedure} [list $dll $loaded] { - list [info loaded {}] [info loaded child] - } [list [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]] - test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded] { - load [file join $testDir pkgb$ext] pkgb - list [info loaded {}] [lsort [info commands pkgb_*]] - } [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_sub pkgb_unsafe}] - interp delete child -} - +test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] { + info loaded +} [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded] +test load-8.2 {TclGetLoadedPackages procedure} [list teststaticpkg] { + list [catch {info loaded gorp} msg] $msg +} {1 {could not find interpreter "gorp"}} +test load-8.3 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] { + list [info loaded {}] [info loaded child] +} [list [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]] +test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded teststaticpkg] { + load [file join $testDir pkgb$ext] pkgb + list [info loaded {}] [lsort [info commands pkgb_*]] +} [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_sub pkgb_unsafe}] +interp delete child + +test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} \ + -constraints {teststaticpkg} \ + -setup { + interp create child1 + interp create child2 + load {} Tcltest child1 + load {} Tcltest child2 + } \ + -body { + child1 eval { teststaticpkg Loadninepointone 0 1 } + child2 eval { teststaticpkg Loadninepointone 0 1 } + list \ + [child1 eval { info loaded {} }] \ + [child2 eval { info loaded {} }] + } \ + -result {{{{} Loadninepointone} {{} Tcltest}} {{{} Loadninepointone} {{} Tcltest}}} \ + -cleanup { interp delete child1 ; interp delete child2 } + + # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - - |