diff options
author | Kevin B Kenny <kennykb@acm.org> | 2003-02-01 23:37:28 (GMT) |
---|---|---|
committer | Kevin B Kenny <kennykb@acm.org> | 2003-02-01 23:37:28 (GMT) |
commit | 82148735c813322bfb1f0fc68327f4dca5c445d2 (patch) | |
tree | f0e6ff72ed25f343bd9b1789ecf7d2f55c8ff307 /generic/tclLoad.c | |
parent | 2186d565ba4e59be880114e0330457cc9143c2d4 (diff) | |
download | tcl-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.c | 58 |
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; |