* generic/tclLoad.c: Changed the code so that if Tcl_StaticPackage

	is called to report the same package as being loaded in two interps,
	it shows up in [info loaded {}] in both of them (previously,
	it didn't appear in the static package list in the second.

	* tests/load.test Added regression test for the above bug.
	[Bug 670042]

1 files changed, 72 insertions, 61 deletions

diff --git a/tests/load.test b/tests/load.test
index db2d073..bd480b9 100644
--- a/tests/load.test
+++ b/tests/load.test
@@ -10,7 +10,7 @@
 # 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.10 2002/06/22 04:19:47 dgp Exp $
+# RCS: @(#) $Id: load.test,v 1.11 2003/02/01 23:37:29 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -41,22 +41,28 @@ set alreadyLoaded [info loaded]
 
 set alreadyTotalLoaded [info loaded]
 
-test load-1.1 {basic errors} [list $dll $loaded] {
+# Certain tests require the 'teststaticpkg' command from tcltest
+
+::tcltest::testConstraint teststaticpkg \
+    [string compare {} [info commands teststaticpkg]]
+
+
+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 $dll $loaded] {
+} "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 $dll $loaded] {
+} "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 $dll $loaded] {
+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 $dll $loaded] {
+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 $dll $loaded] {
+test load-1.6 {basic errors} {} {
     list [catch {load {} Unknown} msg] $msg
 } {1 {package "Unknown" isn't loaded statically}}
 
@@ -133,63 +139,68 @@ 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} [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} [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]
-    } {1 {can't use package in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded}
-    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} \
-	    [list $dll $loaded] {
+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}
+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 $dll $loaded] {
-	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.2 {TclGetLoadedPackages procedure} [list $dll $loaded] {
-	list [catch {info loaded gorp} msg] $msg
-    } {1 {could not find interpreter "gorp"}}
-    test load-8.3 {TclGetLoadedPackages procedure} [list $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] {
-	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-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
+    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.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_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 }
+
+    
 # cleanup
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-