summaryrefslogtreecommitdiffstats
path: root/tests/load.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/load.test')
-rw-r--r--tests/load.test255
1 files changed, 255 insertions, 0 deletions
diff --git a/tests/load.test b/tests/load.test
new file mode 100644
index 0000000..4cd1fcd
--- /dev/null
+++ b/tests/load.test
@@ -0,0 +1,255 @@
+# 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: