diff options
Diffstat (limited to 'tests/load.test')
| -rw-r--r-- | tests/load.test | 244 |
1 files changed, 99 insertions, 145 deletions
diff --git a/tests/load.test b/tests/load.test index be5b1c1..f5c08e9 100644 --- a/tests/load.test +++ b/tests/load.test @@ -4,20 +4,17 @@ # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # -# Copyright © 1995 Sun Microsystems, Inc. -# Copyright © 1998-1999 Scriptics Corporation. +# 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. -if {"::tcltest" ni [namespace children]} { - package require tcltest 2.5 +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest 2 namespace import -force ::tcltest::* } -::tcltest::loadTestedCommands -catch [list package require -exact tcl::test [info patchlevel]] - # Figure out what extension is used for shared libraries on this # platform. if {![info exists ext]} { @@ -31,66 +28,58 @@ 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 {}] +set alreadyLoaded [info loaded] testConstraint $loaded [expr {![string match *pkga* $alreadyLoaded]}] set alreadyTotalLoaded [info loaded] -# Certain tests require the 'teststaticlibrary' command from tcltest +# Certain tests require the 'teststaticpkg' command from tcltest -testConstraint teststaticlibrary [llength [info commands teststaticlibrary]] +testConstraint teststaticpkg [llength [info commands teststaticpkg]] # Test load-10.1 requires the 'testsimplefilesystem' command from tcltest testConstraint testsimplefilesystem \ [llength [info commands testsimplefilesystem]] - -test load-1.1 {basic errors} -returnCodes error -body { - load -} -result {wrong # args: should be "load ?-global? ?-lazy? ?--? fileName ?prefix? ?interp?"} -test load-1.2 {basic errors} -returnCodes error -body { - load a b c d -} -result {wrong # args: should be "load ?-global? ?-lazy? ?--? fileName ?prefix? ?interp?"} -test load-1.3 {basic errors} -returnCodes error -body { - load a b foobar -} -result {could not find interpreter "foobar"} -test load-1.4 {basic errors} -returnCodes error -body { - load -global {} -} -result {must specify either file name or prefix} -test load-1.5 {basic errors} -returnCodes error -body { - load -lazy {} {} -} -result {must specify either file name or prefix} -test load-1.6 {basic errors} -returnCodes error -body { - load {} Unknown -} -result {no library with prefix "Unknown" is loaded statically} -test load-1.7 {basic errors} -returnCodes error -body { - load -abc foo -} -result {bad option "-abc": must be -global, -lazy, or --} -test load-1.8 {basic errors} -returnCodes error -body { - load -global -} -result {couldn't figure out prefix for -global} -test load-2.1 {basic loading, with guess for package name} -constraints \ - [list $dll $loaded deprecated] -body { - load -global [file join $testDir pkga$ext] - list [pkga_eq abc def] [lsort [info commands pkga_*]] -} -result {0 {pkga_eq pkga_quote}} +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 [catch {load a b c d} msg] $msg +} "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 [catch {load {}} msg] $msg +} {1 {must specify either file name or package name}} +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 [catch {load {} Unknown} msg] $msg +} {1 {package "Unknown" isn't loaded statically}} + +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} \ [list $dll $loaded] { - load -lazy [file join $testDir pkgb$ext] Pkgb child + 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} -constraints [list $dll $loaded] \ -body { - 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}] + list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg +} -match glob -result {1 {*couldn't find procedure 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 library in a safe interpreter: no Pkga_SafeInit procedure}} +} {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}} test load-3.1 {error in _Init procedure, same interpreter} \ [list $dll $loaded] { @@ -103,7 +92,7 @@ test load-3.1 {error in _Init procedure, same interpreter} \ "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, child interpreter} \ +test load-3.2 {error in _Init procedure, slave interpreter} \ [list $dll $loaded] { catch {interp delete x} interp create x @@ -124,22 +113,20 @@ test load-3.2 {error in _Init procedure, child 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} -setup { - catch {load [file join $testDir pkga$ext] Pkga} -} -constraints [list $dll $loaded] -returnCodes error -body { - load [file join $testDir pkga$ext] Pkgb -} -result "file \"[file join $testDir pkga$ext]\" is already loaded for prefix \"Pkga\"" +test load-4.2 {reloading package into same interpreter} [list $dll $loaded] { + list [catch {load [file join $testDir pkga$ext] pkgb} msg] $msg +} [list 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} -setup { +test load-5.1 {file name not specified and no static package: pick default} \ + [list $dll $loaded] { catch {interp delete x} interp create x -} -constraints [list $dll $loaded] -body { - load -global [file join $testDir pkga$ext] Pkga - load {} Pkga x - info loaded x -} -cleanup { + load [file join $testDir pkga$ext] pkga + load {} pkga x + set result [info loaded x] interp delete x -} -result [list [list [file join $testDir pkga$ext] Pkga]] + set result +} [list [list [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. @@ -150,108 +137,75 @@ test load-6.1 {errors loading file} [list $dll $loaded] { catch {load foo foo} } {1} -test load-7.1 {Tcl_StaticLibrary procedure} [list teststaticlibrary] { +test load-7.1 {Tcl_StaticPackage procedure} [list teststaticpkg] { set x "not loaded" - teststaticlibrary Test 1 0 - load {} test - load {} test child + teststaticpkg Test 1 0 + load {} Test + load {} Test child list [set x] [child eval set x] } {loaded loaded} -test load-7.2 {Tcl_StaticLibrary procedure} [list teststaticlibrary] { +test load-7.2 {Tcl_StaticPackage procedure} [list teststaticpkg] { set x "not loaded" - teststaticlibrary Another 0 0 + 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 library in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded} -test load-7.3 {Tcl_StaticLibrary procedure} [list teststaticlibrary] { +} {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" - teststaticlibrary More 0 1 - load {} more + teststaticpkg More 0 1 + load {} More set x } {not loaded} -catch {load [file join $testDir pkga$ext] Pkga} -catch {load [file join $testDir pkgb$ext] Pkgb} -catch {load [file join $testDir pkge$ext] Pkge} -set currentRealLibraries [list [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] -test load-7.4 {Tcl_StaticLibrary procedure, redundant calls} -setup { - teststaticlibrary Test 1 0 - teststaticlibrary Another 0 0 - teststaticlibrary More 0 1 -} -constraints [list teststaticlibrary $dll $loaded deprecated] -body { - teststaticlibrary Double 0 1 - teststaticlibrary Double 0 1 +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 teststaticpkg $dll $loaded] { info loaded -} -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealLibraries {*}$alreadyTotalLoaded] - -testConstraint teststaticlibrary_8.x 0 -if {[testConstraint teststaticlibrary]} { - catch { - teststaticlibrary Test 1 1 - teststaticlibrary Another 0 1 - teststaticlibrary More 0 1 - teststaticlibrary Double 0 1 - testConstraint teststaticlibrary_8.x 1 - } -} - -test load-8.1 {TclGetLoadedLibraries procedure} [list teststaticlibrary_8.x $dll $loaded] { - lsort -index 1 [info loaded] -} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealLibraries {*}$alreadyTotalLoaded]] -test load-8.2 {TclGetLoadedLibraries procedure} -constraints {teststaticlibrary_8.x} -body { - info loaded gorp -} -returnCodes error -result {could not find interpreter "gorp"} -test load-8.3a {TclGetLoadedLibraries procedure} [list teststaticlibrary_8.x $dll $loaded] { - lsort -index 1 [info loaded {}] -} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga] [list [file join $testDir pkgb$ext] Pkgb] {*}$alreadyLoaded]] -test load-8.3b {TclGetLoadedLibraries procedure} [list teststaticlibrary_8.x $dll $loaded] { - lsort -index 1 [info loaded child] -} [lsort -index 1 [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]] -test load-8.4 {TclGetLoadedLibraries procedure} [list teststaticlibrary_8.x $dll $loaded] { - load [file join $testDir pkgb$ext] Pkgb - list [lsort -index 1 [info loaded {}]] [lsort [info commands pkgb_*]] -} [list [lsort -index 1 [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded]] {pkgb_demo pkgb_sub pkgb_unsafe}] +} [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_StaticLibrary, load already-loaded package into another interp} -setup { - interp create child1 - interp create child2 - load {} Tcltest child1 - load {} Tcltest child2 -} -constraints {teststaticlibrary} -body { - child1 eval { teststaticlibrary Loadninepointone 0 1 } - child2 eval { teststaticlibrary Loadninepointone 0 1 } - list [child1 eval { info loaded {} }] \ - [child2 eval { info loaded {} }] -} -match glob -cleanup { - interp delete child1 - interp delete child2 -} -result {{{{} Loadninepointone} {* Tcltest}} {{{} Loadninepointone} {* Tcltest}}} - -test load-10.1 {load from vfs} -setup { - set dir [pwd] - cd $testDir - testsimplefilesystem 1 -} -constraints [list $dll $loaded testsimplefilesystem] -body { - list [catch {load simplefs:/pkgd$ext Pkgd} msg] $msg -} -result {0 {}} -cleanup { - testsimplefilesystem 0 - cd $dir - unset dir -} +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 } + +test load-10.1 {load from vfs} \ + -constraints [list $dll $loaded testsimplefilesystem] \ + -setup {set dir [pwd]; cd $testDir; testsimplefilesystem 1} \ + -body {list [catch {load simplefs:/pkgd$ext pkgd} msg] $msg} \ + -result {0 {}} \ + -cleanup {testsimplefilesystem 0; cd $dir; unset dir} -test load-11.1 {Load TclOO extension using Stubs (Bug [f51efe99a7])} \ - [list $dll $loaded] { - load [file join $testDir pkgooa$ext] - list [pkgooa_stubsok] [lsort [info commands pkgooa_*]] -} {1 pkgooa_stubsok} - # cleanup unset ext ::tcltest::cleanupTests return - -# Local Variables: -# mode: tcl -# End: |