summaryrefslogtreecommitdiffstats
path: root/generic/tclLoad.c
diff options
context:
space:
mode:
authorKevin B Kenny <kennykb@acm.org>2003-02-01 23:37:28 (GMT)
committerKevin B Kenny <kennykb@acm.org>2003-02-01 23:37:28 (GMT)
commit82148735c813322bfb1f0fc68327f4dca5c445d2 (patch)
treef0e6ff72ed25f343bd9b1789ecf7d2f55c8ff307 /generic/tclLoad.c
parent2186d565ba4e59be880114e0330457cc9143c2d4 (diff)
downloadtcl-82148735c813322bfb1f0fc68327f4dca5c445d2.zip
tcl-82148735c813322bfb1f0fc68327f4dca5c445d2.tar.gz
tcl-82148735c813322bfb1f0fc68327f4dca5c445d2.tar.bz2
* 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]
Diffstat (limited to 'generic/tclLoad.c')
-rw-r--r--generic/tclLoad.c58
1 files changed, 40 insertions, 18 deletions
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;