summaryrefslogtreecommitdiffstats
path: root/tests/load.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/load.test')
-rw-r--r--tests/load.test160
1 files changed, 160 insertions, 0 deletions
diff --git a/tests/load.test b/tests/load.test
new file mode 100644
index 0000000..5c33677
--- /dev/null
+++ b/tests/load.test
@@ -0,0 +1,160 @@
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) load.test 1.19 96/11/30 16:05:18
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# 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"
+ return
+}
+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
+}
+
+if [string match *pkga* [set alreadyLoaded [info loaded {}]]] {
+ puts "load tests have already been run once: skipping (can't rerun)"
+ return
+}
+
+set alreadyTotalLoaded [info loaded]
+
+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 {couldn't find slave interpreter named "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} {
+ 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} {
+ 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} {
+ 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} {
+ 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
+} {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
+"load [file join $testDir pkge$ext] pkge"} {POSIX ENOENT {no such file or directory}}}
+test load-3.2 {error in _Init procedure, slave interpreter} {
+ 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
+"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 [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
+} {0 {}}
+test load-4.2 {reloading package into same interpreter} {
+ 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} {
+ catch {interp delete x}
+ interp create x
+ load [file join $testDir pkga$ext] pkga
+ load {} pkga x
+ set result [info loaded x]
+ interp delete x
+ set result
+} "{[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.
+
+test load-6.1 {errors loading file} {nonPortable} {
+ catch {load foo foo}
+} {1}
+
+if {[info command teststaticpkg] != ""} {
+ test load-7.1 {Tcl_StaticPackage procedure} {
+ 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} {
+ 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} {
+ set x "not loaded"
+ teststaticpkg More 0 1
+ load {} More
+ set x
+ } {not loaded}
+ test load-7.4 {Tcl_StaticPackage procedure, redundant calls} {
+ 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} {
+ 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} {
+ list [catch {info loaded gorp} msg] $msg
+ } {1 {couldn't find slave interpreter named "gorp"}}
+ test load-8.3 {TclGetLoadedPackages procedure} {
+ 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} {
+ 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
+}