diff options
Diffstat (limited to 'tcl/tests/load.test')
| -rw-r--r-- | tcl/tests/load.test | 110 |
1 files changed, 73 insertions, 37 deletions
diff --git a/tcl/tests/load.test b/tcl/tests/load.test index 25a1c960d6a..bd746ae6fe9 100644 --- a/tcl/tests/load.test +++ b/tcl/tests/load.test @@ -5,79 +5,93 @@ # generates output for errors. No output means no errors were found. # # Copyright (c) 1995 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id$ -if {[string compare test [info procs test]] == 1} then {source defs} +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest + namespace import -force ::tcltest::* +} # Figure out what extension is used for shared libraries on this # platform. if {$tcl_platform(platform) == "macintosh"} { puts "can't run dynamic library tests on macintosh machines" + ::tcltest::cleanupTests return } + +# Tests require the existence of one of the DLLs in the dltest directory. set ext [info sharedlibextension] set testDir [file join [file dirname [info nameofexecutable]] dltest] -if ![file readable [file join $testDir pkga$ext]] { - puts "libraries in $testDir haven't been compiled: skipping tests" - return -} +set x [file join $testDir pkga$ext] +set dll "[file tail $x]Required" +set ::tcltest::testConstraints($dll) [file readable $x] -if [string match *pkga* [set alreadyLoaded [info loaded]]] { - puts "load tests have already been run once: skipping (can't rerun)" - return -} +# Tests also require that this DLL has not already been loaded. +set loaded "[file tail $x]Loaded" +set alreadyLoaded [info loaded] +set ::tcltest::testConstraints($loaded) \ + [expr {![string match *pkga* $alreadyLoaded]}] set alreadyTotalLoaded [info loaded] -test load-1.1 {basic errors} { +test load-1.1 {basic errors} [list $dll $loaded] { list [catch {load} msg] $msg } {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}} -test load-1.2 {basic errors} { +test load-1.2 {basic errors} [list $dll $loaded] { list [catch {load a b c d} msg] $msg } {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}} -test load-1.3 {basic errors} { +test load-1.3 {basic errors} [list $dll $loaded] { list [catch {load a b foobar} msg] $msg -} {1 {couldn't find slave interpreter named "foobar"}} -test load-1.4 {basic errors} { +} {1 {could not find interpreter "foobar"}} +test load-1.4 {basic errors} [list $dll $loaded] { list [catch {load {}} msg] $msg } {1 {must specify either file name or package name}} -test load-1.5 {basic errors} { +test load-1.5 {basic errors} [list $dll $loaded] { list [catch {load {} {}} msg] $msg } {1 {must specify either file name or package name}} -test load-1.6 {basic errors} { +test load-1.6 {basic errors} [list $dll $loaded] { list [catch {load {} Unknown} msg] $msg } {1 {package "Unknown" isn't loaded statically}} -test load-2.1 {basic loading, with guess for package name} { +test load-2.1 {basic loading, with guess for package name} \ + [list $dll $loaded] { load [file join $testDir pkga$ext] list [pkga_eq abc def] [info commands pkga_*] } {0 {pkga_eq pkga_quote}} interp create -safe child -test load-2.2 {loading into a safe interpreter, with package name conversion} { +test load-2.2 {loading into a safe interpreter, with package name conversion} \ + [list $dll $loaded] { load [file join $testDir pkgb$ext] pKgB child list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \ [catch {pkgb_sub 12 10} msg2] $msg2 } {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}} -test load-2.3 {loading with no _Init procedure} { +test load-2.3 {loading with no _Init procedure} [list $dll $loaded] { list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg } {1 {couldn't find procedure Foo_Init}} -test load-2.4 {loading with no _SafeInit procedure} { +test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] { list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg } {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}} -test load-3.1 {error in _Init procedure, same interpreter} { - list [catch {load [file join $testDir pkge$ext] pkge} msg] $msg $errorInfo $errorCode +test load-3.1 {error in _Init procedure, same interpreter} \ + [list $dll $loaded] { + list [catch {load [file join $testDir pkge$ext] pkge} msg] \ + $msg $errorInfo $errorCode } {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory 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} { +test load-3.2 {error in _Init procedure, slave interpreter} \ + [list $dll $loaded] { catch {interp delete x} interp create x set errorCode foo @@ -90,16 +104,19 @@ 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} { +test load-4.1 {reloading package into same interpreter} [list $dll $loaded] { list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg } {0 {}} -test load-4.2 {reloading package into same interpreter} { +test load-4.2 {reloading package into same interpreter} [list $dll $loaded] { 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} { +test load-5.1 {file name not specified and no static package: pick default} \ + [list $dll $loaded] { catch {interp delete x} interp create x load [file join $testDir pkga$ext] pkga @@ -112,49 +129,68 @@ test load-5.1 {file name not specified and no static package: pick default} { # On some platforms, like SunOS 4.1.3, these tests can't be run because # they cause the process to exit. -test load-6.1 {errors loading file} {nonPortable} { +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} { + 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} { + 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] + 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} { + 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} { + test load-7.4 {Tcl_StaticPackage procedure, redundant calls} \ + [list $dll $loaded] { 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} { + test load-8.1 {TclGetLoadedPackages procedure} [list $dll $loaded] { 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.2 {TclGetLoadedPackages procedure} { + test load-8.2 {TclGetLoadedPackages procedure} [list $dll $loaded] { list [catch {info loaded gorp} msg] $msg - } {1 {couldn't find slave interpreter named "gorp"}} - test load-8.3 {TclGetLoadedPackages procedure} { + } {1 {could not find interpreter "gorp"}} + test load-8.3 {TclGetLoadedPackages procedure} [list $dll $loaded] { list [info loaded {}] [info loaded child] } "{{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {{{} Test} {[file join $testDir pkgb$ext] Pkgb}}" - test load-8.4 {TclGetLoadedPackages procedure} { + test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded] { load [file join $testDir pkgb$ext] pkgb list [info loaded {}] [lsort [info commands pkgb_*]] } "{{[file join $testDir pkgb$ext] Pkgb} {{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {pkgb_sub pkgb_unsafe}" interp delete child } + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + |