merged tcl 8.1 branch back into the main trunk

1 files changed, 72 insertions, 38 deletions

diff --git a/tests/load.test b/tests/load.test
index d5b27ae..8bbfb98 100644
--- a/tests/load.test
+++ b/tests/load.test
@@ -5,79 +5,92 @@
 # 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.
 #
-# RCS: @(#) $Id: load.test,v 1.3 1998/11/12 05:54:21 welch Exp $
+# RCS: @(#) $Id: load.test,v 1.4 1999/04/16 00:47:30 stanton Exp $
 
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 # 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
 }
+
+# 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]
-if ![file readable [file join $testDir pkga$ext]] {
-    puts "libraries in $testDir haven't been compiled: skipping tests"
-    return
-}
+set x [file join $testDir pkga$ext]
+set dll "[file tail $x]Required"
+set ::tcltest::testConfig($dll) [file readable $x]
 
-if [string match *pkga* [set alreadyLoaded [info loaded]]] {
-    puts "load tests have already been run once:  skipping (can't rerun)"
-    return
-}
+# Tests also require that this DLL has not already been loaded.
+set loaded "[file tail $x]Loaded"
+set alreadyLoaded [info loaded]
+set ::tcltest::testConfig($loaded) \
+	[expr {![string match *pkga* $alreadyLoaded]}]
 
 set alreadyTotalLoaded [info loaded]
 
-test load-1.1 {basic errors} {
+test load-1.1 {basic errors} [list $dll $loaded] {
     list [catch {load} msg] $msg
 } {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}}
-test load-1.2 {basic errors} {
+test load-1.2 {basic errors} [list $dll $loaded] {
     list [catch {load a b c d} msg] $msg
 } {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}}
-test load-1.3 {basic errors} {
+test load-1.3 {basic errors} [list $dll $loaded] {
     list [catch {load a b foobar} msg] $msg
-} {1 {couldn't find slave interpreter named "foobar"}}
-test load-1.4 {basic errors} {
+} {1 {could not find interpreter "foobar"}}
+test load-1.4 {basic errors} [list $dll $loaded] {
     list [catch {load {}} msg] $msg
 } {1 {must specify either file name or package name}}
-test load-1.5 {basic errors} {
+test load-1.5 {basic errors} [list $dll $loaded] {
     list [catch {load {} {}} msg] $msg
 } {1 {must specify either file name or package name}}
-test load-1.6 {basic errors} {
+test load-1.6 {basic errors} [list $dll $loaded] {
     list [catch {load {} Unknown} msg] $msg
 } {1 {package "Unknown" isn't loaded statically}}
 
-test load-2.1 {basic loading, with guess for package name} {
+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} {
+test load-2.2 {loading into a safe interpreter, with package name conversion} \
+	[list $dll $loaded] {
     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} {
+test load-2.3 {loading with no _Init procedure} [list $dll $loaded] {
     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} {
+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 [catch {load [file join $testDir pkge$ext] pkge} msg] $msg $errorInfo $errorCode
+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} {
+test load-3.2 {error in _Init procedure, slave interpreter} \
+	[list $dll $loaded] {
     catch {interp delete x}
     interp create x
     set errorCode foo
@@ -90,16 +103,19 @@ test load-3.2 {error in _Init procedure, slave interpreter} {
     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} {
+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} {
+test load-4.2 {reloading package into same interpreter} [list $dll $loaded] {
     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} {
+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 [file join $testDir pkga$ext] pkga
@@ -112,49 +128,67 @@ 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.
 
-test load-6.1 {errors loading file} {nonPortable} {
+test load-6.1 {errors loading file} [list $dll $loaded nonPortable] {
     catch {load foo foo}
 } {1}
 
 if {[info command teststaticpkg] != ""} {
-    test load-7.1 {Tcl_StaticPackage procedure} {
+    test load-7.1 {Tcl_StaticPackage procedure} [list $dll $loaded] {
 	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} {
+    test load-7.2 {Tcl_StaticPackage procedure} [list $dll $loaded] {
 	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]
+	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} {
+    test load-7.3 {Tcl_StaticPackage procedure} [list $dll $loaded] {
 	set x "not loaded"
 	teststaticpkg More 0 1
 	load {} More
 	set x
     } {not loaded}
-    test load-7.4 {Tcl_StaticPackage procedure, redundant calls} {
+    test load-7.4 {Tcl_StaticPackage procedure, redundant calls} \
+	    [list $dll $loaded] {
 	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} {
+    test load-8.1 {TclGetLoadedPackages procedure} [list $dll $loaded] {
 	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} {
+    test load-8.2 {TclGetLoadedPackages procedure} [list $dll $loaded] {
 	list [catch {info loaded gorp} msg] $msg
-    } {1 {couldn't find slave interpreter named "gorp"}}
-    test load-8.3 {TclGetLoadedPackages procedure} {
+    } {1 {could not find interpreter "gorp"}}
+    test load-8.3 {TclGetLoadedPackages procedure} [list $dll $loaded] {
 	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} {
+    test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded] {
 	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
 }
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+