* 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]

3 files changed, 122 insertions, 79 deletions

diff --git a/ChangeLog b/ChangeLog
index 3e9a770..78c17f0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,15 @@
 2003-02-01  Kevin Kenny  <kennykb@users.sourceforge.net>
 
+	* 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]
+	
+2003-02-01  Kevin Kenny  <kennykb@users.sourceforge.net>
+
 	* generic/tclClock.c: Fixed a bug that incorrectly allowed
 	[clock clicks {}] and [clock clicks -] to be accepted as if
 	they were [clock clicks -milliseconds].
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 959fd7b..6773ac4 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclLoad.c,v 1.8 2002/07/22 16:51:48 vincentdarley Exp $
+ * RCS: @(#) $Id: tclLoad.c,v 1.9 2003/02/01 23:37:29 kennykb Exp $
  */
 
 #include "tclInt.h"
@@ -469,7 +469,7 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
 
     /*
      * Check to see if someone else has already reported this package as
-     * statically loaded.  If this call is redundant then just return.
+     * statically loaded in the process.
      */
 
     Tcl_MutexLock(&packageMutex);
@@ -477,30 +477,52 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
 	if ((pkgPtr->initProc == initProc)
 		&& (pkgPtr->safeInitProc == safeInitProc)
 		&& (strcmp(pkgPtr->packageName, pkgName) == 0)) {
-	    Tcl_MutexUnlock(&packageMutex);
-	    return;
+	    break;
 	}
     }
-
     Tcl_MutexUnlock(&packageMutex);
 
-    pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
-    pkgPtr->fileName		= (char *) ckalloc((unsigned) 1);
-    pkgPtr->fileName[0]		= 0;
-    pkgPtr->packageName		= (char *) ckalloc((unsigned)
-	    (strlen(pkgName) + 1));
-    strcpy(pkgPtr->packageName, pkgName);
-    pkgPtr->loadHandle		= NULL;
-    pkgPtr->initProc		= initProc;
-    pkgPtr->safeInitProc	= safeInitProc;
-    Tcl_MutexLock(&packageMutex);
-    pkgPtr->nextPtr		= firstPackagePtr;
-    firstPackagePtr		= pkgPtr;
-    Tcl_MutexUnlock(&packageMutex);
+    /*
+     * If the package is not yet recorded as being loaded statically,
+     * add it to the list now.
+     */
+
+    if ( pkgPtr == NULL ) {
+	pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
+	pkgPtr->fileName	= (char *) ckalloc((unsigned) 1);
+	pkgPtr->fileName[0]	= 0;
+	pkgPtr->packageName	= (char *) ckalloc((unsigned)
+						   (strlen(pkgName) + 1));
+	strcpy(pkgPtr->packageName, pkgName);
+	pkgPtr->loadHandle	= NULL;
+	pkgPtr->initProc	= initProc;
+	pkgPtr->safeInitProc	= safeInitProc;
+	Tcl_MutexLock(&packageMutex);
+	pkgPtr->nextPtr		= firstPackagePtr;
+	firstPackagePtr		= pkgPtr;
+	Tcl_MutexUnlock(&packageMutex);
+    }
 
     if (interp != NULL) {
+
+	/*
+	 * If we're loading the package into an interpreter,
+	 * determine whether it's already loaded. 
+	 */
+
 	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(interp, "tclLoad",
 		(Tcl_InterpDeleteProc **) NULL);
+	for ( ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr ) {
+	    if ( ipPtr->pkgPtr == pkgPtr ) {
+		return;
+	    }
+	}
+
+	/*
+	 * Package isn't loade in the current interp yet. Mark it as
+	 * now being loaded.
+	 */
+
 	ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
 	ipPtr->pkgPtr = pkgPtr;
 	ipPtr->nextPtr = ipFirstPtr;
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
-
-
-
-
-
-
-
-
-
-
-
-