diff options
Diffstat (limited to 'tcl8.6/tests/load.test')
| -rw-r--r-- | tcl8.6/tests/load.test | 255 |
1 files changed, 0 insertions, 255 deletions
diff --git a/tcl8.6/tests/load.test b/tcl8.6/tests/load.test deleted file mode 100644 index 4cd1fcd..0000000 --- a/tcl8.6/tests/load.test +++ /dev/null @@ -1,255 +0,0 @@ -# Commands covered: load -# -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# 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. - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 - namespace import -force ::tcltest::* -} - -::tcltest::loadTestedCommands -catch [list package require -exact Tcltest [info patchlevel]] - -# Figure out what extension is used for shared libraries on this -# platform. -if {![info exists ext]} { - set ext [info sharedlibextension] -} -# Tests require the existence of one of the DLLs in the dltest directory. -set testDir [file join [file dirname [info nameofexecutable]] dltest] -set x [file join $testDir pkga$ext] -set dll "[file tail $x]Required" -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] -testConstraint $loaded [expr {![string match *pkga* $alreadyLoaded]}] - -set alreadyTotalLoaded [info loaded] - -# Certain tests require the 'teststaticpkg' command from tcltest - -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} {} { - list [catch {load} msg] $msg -} "1 {wrong \# args: should be \"load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?\"}" -test load-1.2 {basic errors} {} { - list [catch {load a b c d} msg] $msg -} "1 {wrong \# args: should be \"load ?-global? ?-lazy? ?--? 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 -global {}} msg] $msg -} {1 {must specify either file name or package name}} -test load-1.5 {basic errors} {} { - list [catch {load -lazy {} {}} 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-1.7 {basic errors} {} { - list [catch {load -abc foo} msg] $msg -} "1 {bad option \"-abc\": must be -global, -lazy, or --}" -test load-1.8 {basic errors} {} { - list [catch {load -global} msg] $msg -} "1 {couldn't figure out package name for -global}" - -test load-2.1 {basic loading, with guess for package name} \ - [list $dll $loaded] { - load -global [file join $testDir pkga$ext] - 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} \ - [list $dll $loaded] { - load -lazy [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}] -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 $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} \ - [list $dll $loaded] { - catch {interp delete x} - interp create x - set ::errorCode foo - set ::errorInfo bar - set result [list [catch {load [file join $testDir pkge$ext] pkge x} msg] \ - $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 - 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} [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 package \"Pkga\"" - -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 -global [file join $testDir pkga$ext] pkga - load {} pkga x - set result [info loaded x] - interp delete x - 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. -# -# As of 2005, such ancient broken systems no longer matter. - -test load-6.1 {errors loading file} [list $dll $loaded] { - catch {load foo foo} -} {1} - -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} -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 currentRealPackages [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_StaticPackage procedure, redundant calls} -setup { - teststaticpkg Test 1 0 - teststaticpkg Another 0 0 - teststaticpkg More 0 1 -} -constraints [list teststaticpkg $dll $loaded] -body { - teststaticpkg Double 0 1 - teststaticpkg Double 0 1 - info loaded -} -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded] - -testConstraint teststaticpkg_8.x \ - [if {[testConstraint teststaticpkg]} { - teststaticpkg Test 1 1 - teststaticpkg Another 0 1 - teststaticpkg More 0 1 - teststaticpkg Double 0 1 - expr 1 - } else { - expr 0 - }] - -test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] { - lsort -index 1 [info loaded] -} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]] -test load-8.2 {TclGetLoadedPackages procedure} -constraints {teststaticpkg_8.x} -body { - info loaded gorp -} -returnCodes error -result {could not find interpreter "gorp"} -test load-8.3a {TclGetLoadedPackages procedure} [list teststaticpkg_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 {TclGetLoadedPackages procedure} [list teststaticpkg_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 {TclGetLoadedPackages procedure} [list teststaticpkg_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}] -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 {} }] - } \ - -match glob -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: |