diff options
Diffstat (limited to 'tests/load.test')
| -rw-r--r-- | tests/load.test | 51 |
1 files changed, 26 insertions, 25 deletions
diff --git a/tests/load.test b/tests/load.test index 4794bd1..b7c1a59 100644 --- a/tests/load.test +++ b/tests/load.test @@ -17,39 +17,31 @@ if {[lsearch [namespace children] ::tcltest] == -1} { # 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 +if {![info exists ext]} { + set ext [info sharedlibextension] } - # 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] set x [file join $testDir pkga$ext] set dll "[file tail $x]Required" -::tcltest::testConstraint $dll [file readable $x] +testConstraint $dll [file readable $x] # Tests also require that this DLL has not already been loaded. set loaded "[file tail $x]Loaded" set alreadyLoaded [info loaded] -::tcltest::testConstraint $loaded \ - [expr {![string match *pkga* $alreadyLoaded]}] +testConstraint $loaded [expr {![string match *pkga* $alreadyLoaded]}] set alreadyTotalLoaded [info loaded] # Certain tests require the 'teststaticpkg' command from tcltest -::tcltest::testConstraint teststaticpkg \ - [string compare {} [info commands teststaticpkg]] +testConstraint teststaticpkg [llength [info commands teststaticpkg]] # Test load-10.1 requires the 'testsimplefilesystem' command from tcltest -::tcltest::testConstraint testsimplefilesystem \ - [string compare {} [info commands testsimplefilesystem]] - - +testConstraint testsimplefilesystem \ + [llength [info commands testsimplefilesystem]] + test load-1.1 {basic errors} {} { list [catch {load} msg] $msg } "1 {wrong \# args: should be \"load fileName ?packageName? ?interp?\"}" @@ -72,7 +64,7 @@ test load-1.6 {basic errors} {} { 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_*] + list [pkga_eq abc def] [lsort [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} \ @@ -83,8 +75,10 @@ test load-2.2 {loading into a safe interpreter, with package name conversion} \ } {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}} test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \ -body { - list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg -} -match glob -result {1 {*couldn't find procedure Foo_Init}} + list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode +} -match glob \ + -result [list 1 {cannot find symbol "Foo_Init"*} \ + {TCL LOOKUP LOAD_SYMBOL *Foo_Init}] 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}} @@ -92,7 +86,7 @@ test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] { 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 + $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" @@ -104,10 +98,10 @@ test load-3.2 {error in _Init procedure, slave interpreter} \ [list $dll $loaded] { catch {interp delete x} interp create x - set errorCode foo - set errorInfo bar + set ::errorCode foo + set ::errorInfo bar set result [list [catch {load [file join $testDir pkge$ext] pkge x} msg] \ - $msg $errorInfo $errorCode] + $msg $::errorInfo $::errorCode] interp delete x set result } {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory @@ -138,8 +132,10 @@ 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. +# +# As of 2005, such ancient broken systems no longer matter. -test load-6.1 {errors loading file} [list $dll $loaded nonPortable] { +test load-6.1 {errors loading file} [list $dll $loaded] { catch {load foo foo} } {1} @@ -210,7 +206,12 @@ test load-10.1 {load from vfs} \ -body {list [catch {load simplefs:/pkgd$ext pkgd} msg] $msg} \ -result {0 {}} \ -cleanup {testsimplefilesystem 0; cd $dir; unset dir} - + # cleanup +unset ext ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: |