diff options
Diffstat (limited to 'contrib/tcl/tests/load.test')
| -rw-r--r-- | contrib/tcl/tests/load.test | 49 |
1 files changed, 31 insertions, 18 deletions
diff --git a/contrib/tcl/tests/load.test b/contrib/tcl/tests/load.test index 331e3b7..5c33677 100644 --- a/contrib/tcl/tests/load.test +++ b/contrib/tcl/tests/load.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# SCCS: %Z% %M% %I% %E% %U% +# SCCS: @(#) load.test 1.19 96/11/30 16:05:18 if {[string compare test [info procs test]] == 1} then {source defs} @@ -27,11 +27,13 @@ if ![file readable [file join $testDir pkga$ext]] { return } -if [string match *pkga* [info loaded]] { +if [string match *pkga* [set alreadyLoaded [info loaded {}]]] { puts "load tests have already been run once: skipping (can't rerun)" return } +set alreadyTotalLoaded [info loaded] + test load-1.1 {basic errors} { list [catch {load} msg] $msg } {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}} @@ -74,8 +76,6 @@ test load-3.1 {error in _Init procedure, same interpreter} { while executing "open non_existent" invoked from within -"if 44 {open non_existent}" - invoked from within "load [file join $testDir pkge$ext] pkge"} {POSIX ENOENT {no such file or directory}}} test load-3.2 {error in _Init procedure, slave interpreter} { catch {interp delete x} @@ -90,8 +90,6 @@ test load-3.2 {error in _Init procedure, slave interpreter} { while executing "open non_existent" invoked from within -"if 44 {open non_existent}" - invoked from within "load [file join $testDir pkge$ext] pkge x"} {POSIX ENOENT {no such file or directory}}} test load-4.1 {reloading package into same interpreter} { @@ -101,47 +99,62 @@ test load-4.2 {reloading package into same interpreter} { list [catch {load [file join $testDir pkga$ext] pkgb} msg] $msg } "1 {file \"[file join $testDir pkga$ext\"] is already loaded for package \"Pkga\"}" +test load-5.1 {file name not specified and no static package: pick default} { + catch {interp delete x} + interp create x + load [file join $testDir pkga$ext] pkga + load {} pkga x + set result [info loaded x] + interp delete x + set result +} "{[file join $testDir pkga$ext] Pkga}" + # On some platforms, like SunOS 4.1.3, these tests can't be run because # they cause the process to exit. -test load-5.1 {errors loading file} {nonPortable} { +test load-6.1 {errors loading file} {nonPortable} { catch {load foo foo} } {1} if {[info command teststaticpkg] != ""} { - test load-6.1 {Tcl_StaticPackage procedure, static packages} { + test load-7.1 {Tcl_StaticPackage procedure} { set x "not loaded" teststaticpkg Test 1 0 load {} Test load {} Test child list [set x] [child eval set x] } {loaded loaded} - test load-6.2 {Tcl_StaticPackage procedure, static packages} { + test load-7.2 {Tcl_StaticPackage procedure} { 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-6.3 {Tcl_StaticPackage procedure, static packages} { + test load-7.3 {Tcl_StaticPackage procedure} { set x "not loaded" teststaticpkg More 0 1 load {} More set x } {not loaded} - - test load-7.1 {TclGetLoadedPackages procedure} { + test load-7.4 {Tcl_StaticPackage procedure, redundant calls} { + teststaticpkg Double 0 1 + teststaticpkg Double 0 1 + info loaded + } "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded" + + test load-8.1 {TclGetLoadedPackages procedure} { info loaded - } "{{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} {{} Tcltest}" - test load-7.2 {TclGetLoadedPackages procedure} { + } "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded" + test load-8.2 {TclGetLoadedPackages procedure} { list [catch {info loaded gorp} msg] $msg } {1 {couldn't find slave interpreter named "gorp"}} - test load-7.3 {TclGetLoadedPackages procedure} { + test load-8.3 {TclGetLoadedPackages procedure} { list [info loaded {}] [info loaded child] - } "{{{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} {{} Tcltest}} {{{} Test} {[file join $testDir pkgb$ext] Pkgb}}" - test load-7.4 {TclGetLoadedPackages procedure} { + } "{{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {{{} Test} {[file join $testDir pkgb$ext] Pkgb}}" + test load-8.4 {TclGetLoadedPackages procedure} { load [file join $testDir pkgb$ext] pkgb list [info loaded {}] [lsort [info commands pkgb_*]] - } "{{[file join $testDir pkgb$ext] Pkgb} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} {{} Tcltest}} {pkgb_sub pkgb_unsafe}" + } "{{[file join $testDir pkgb$ext] Pkgb} {{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {pkgb_sub pkgb_unsafe}" interp delete child } |
