1 files changed, 160 insertions, 88 deletions

diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index c9d1b31..ee1862d 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -12,6 +12,7 @@
 
 #include "tclInt.h"
 
+
 /*
  * The following structure describes a library that has been loaded either
  * dynamically (with the "load" command) or statically (as indicated by a call
@@ -93,8 +94,20 @@ typedef struct InterpLibrary {
  * Prototypes for functions that are private to this file:
  */
 
-static void		LoadCleanupProc(ClientData clientData,
-			    Tcl_Interp *interp);
+static void	LoadCleanupProc(ClientData clientData,
+		    Tcl_Interp *interp);
+static int	IsStatic (LoadedLibrary *libraryPtr);
+static int	UnloadLibrary(Tcl_Interp *interp, Tcl_Interp *target,
+		    LoadedLibrary *library, int keepLibrary,
+		    const char *fullFileName, int interpExiting);
+
+
+static int
+IsStatic (LoadedLibrary *libraryPtr) {
+    int res;
+    res = (libraryPtr->fileName[0] == '\0');
+    return res;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -331,7 +344,11 @@ Tcl_LoadObjCmd(
 		pkgGuess += 3;
 	    }
 #endif /* __CYGWIN__ */
-	    if ((pkgGuess[0] == 't') && (pkgGuess[1] == 'c')
+	    if (((pkgGuess[0] == 't')
+#ifdef MAC_OSX_TCL
+		    || (pkgGuess[0] == 'T')
+#endif
+		    ) && (pkgGuess[1] == 'c')
 		    && (pkgGuess[2] == 'l')) {
 		pkgGuess += 3;
 	    }
@@ -527,7 +544,7 @@ Tcl_LoadObjCmd(
  *
  * Tcl_UnloadObjCmd --
  *
- *	This function is invoked to process the "unload" Tcl command. See the
+ *	Implements the the "unload" Tcl command. See the
  *	user documentation for details on what it does.
  *
  * Results:
@@ -547,12 +564,10 @@ Tcl_UnloadObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_Interp *target;		/* Which interpreter to unload from. */
-    LoadedLibrary *libraryPtr, *defaultPtr;
+    LoadedLibrary *libraryPtr;
     Tcl_DString pfx, tmp;
-    Tcl_LibraryUnloadProc *unloadProc;
     InterpLibrary *ipFirstPtr, *ipPtr;
     int i, index, code, complain = 1, keepLibrary = 0;
-    int trustedRefCount = -1, safeRefCount = -1;
     const char *fullFileName = "";
     const char *prefix;
     static const char *const options[] = {
@@ -646,12 +661,11 @@ Tcl_UnloadObjCmd(
      *  - Its prefix and file match the once we're looking for.
      *  - Its file matches, and we weren't given a prefix.
      *  - Its prefix matches, the file name was specified as empty, and there is
-     *	  only no statically loaded library with the same prefix.
+     *	  no statically loaded library with the same prefix.
      */
 
     Tcl_MutexLock(&libraryMutex);
 
-    defaultPtr = NULL;
     for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) {
 	int namesMatch, filesMatch;
 
@@ -677,9 +691,6 @@ Tcl_UnloadObjCmd(
 	if (filesMatch && (namesMatch || (prefix == NULL))) {
 	    break;
 	}
-	if (namesMatch && (fullFileName[0] == 0)) {
-	    defaultPtr = libraryPtr;
-	}
 	if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
 	    break;
 	}
@@ -741,6 +752,51 @@ Tcl_UnloadObjCmd(
 	goto done;
     }
 
+    code = UnloadLibrary(interp, target, libraryPtr, keepLibrary, fullFileName, 0);
+
+  done:
+    Tcl_DStringFree(&pfx);
+    Tcl_DStringFree(&tmp);
+    if (!complain && (code != TCL_OK)) {
+	code = TCL_OK;
+	Tcl_ResetResult(interp);
+    }
+    return code;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UnloadLibrary --
+ *
+ *	Unloads a library from an interpreter, and also from the process if it
+ *	is unloadable, i.e. if it provides an "unload" function.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See description.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+UnloadLibrary(
+	Tcl_Interp *interp,
+	Tcl_Interp *target,
+	LoadedLibrary *libraryPtr,
+	int keepLibrary,
+	const char *fullFileName,
+	int interpExiting
+)
+{
+    int code;
+    InterpLibrary *ipFirstPtr, *ipPtr;
+    LoadedLibrary *iterLibraryPtr;
+    int trustedRefCount = -1, safeRefCount = -1;
+    Tcl_LibraryUnloadProc *unloadProc = NULL;
+
     /*
      * Ensure that the DLL can be unloaded. If it is a trusted interpreter,
      * libraryPtr->unloadProc must not be NULL for the DLL to be unloadable. If
@@ -749,28 +805,34 @@ Tcl_UnloadObjCmd(
 
     if (Tcl_IsSafe(target)) {
 	if (libraryPtr->safeUnloadProc == NULL) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "file \"%s\" cannot be unloaded under a safe interpreter",
-		    fullFileName));
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
-		    NULL);
-	    code = TCL_ERROR;
-	    goto done;
+	    if (!interpExiting) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"file \"%s\" cannot be unloaded under a safe interpreter",
+			fullFileName));
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
+			NULL);
+		code = TCL_ERROR;
+		goto done;
+	    }
 	}
 	unloadProc = libraryPtr->safeUnloadProc;
     } else {
 	if (libraryPtr->unloadProc == NULL) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "file \"%s\" cannot be unloaded under a trusted interpreter",
-		    fullFileName));
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
-		    NULL);
-	    code = TCL_ERROR;
-	    goto done;
+	    if (!interpExiting) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"file \"%s\" cannot be unloaded under a trusted interpreter",
+			fullFileName));
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
+			NULL);
+		code = TCL_ERROR;
+		goto done;
+	    }
 	}
 	unloadProc = libraryPtr->unloadProc;
     }
 
+
+
     /*
      * We are ready to unload the library. First, evaluate the unload
      * function. If this fails, we cannot proceed with unload. Also, we must
@@ -781,32 +843,65 @@ Tcl_UnloadObjCmd(
      * after the callback returns, TCL_UNLOAD_DETACH_FROM_PROCESS is passed.
      */
 
-    code = TCL_UNLOAD_DETACH_FROM_INTERPRETER;
-    if (!keepLibrary) {
-	Tcl_MutexLock(&libraryMutex);
-	trustedRefCount = libraryPtr->interpRefCount;
-	safeRefCount = libraryPtr->safeInterpRefCount;
-	Tcl_MutexUnlock(&libraryMutex);
+    if (unloadProc == NULL) {
+	code = TCL_OK;
+    } else {
+	code = TCL_UNLOAD_DETACH_FROM_INTERPRETER;
+	if (!keepLibrary) {
+	    Tcl_MutexLock(&libraryMutex);
+	    trustedRefCount = libraryPtr->interpRefCount;
+	    safeRefCount = libraryPtr->safeInterpRefCount;
+	    Tcl_MutexUnlock(&libraryMutex);
 
-	if (Tcl_IsSafe(target)) {
-	    safeRefCount--;
-	} else {
-	    trustedRefCount--;
-	}
+	    if (Tcl_IsSafe(target)) {
+		safeRefCount--;
+	    } else {
+		trustedRefCount--;
+	    }
 
-	if (safeRefCount <= 0 && trustedRefCount <= 0) {
-	    code = TCL_UNLOAD_DETACH_FROM_PROCESS;
+	    if (safeRefCount <= 0 && trustedRefCount <= 0) {
+		code = TCL_UNLOAD_DETACH_FROM_PROCESS;
+	    }
 	}
+	code = unloadProc(target, code);
     }
-    code = unloadProc(target, code);
+
+
     if (code != TCL_OK) {
 	Tcl_TransferResult(target, code, interp);
 	goto done;
     }
 
+
+    /*
+     * Remove this library from the interpreter's library cache.
+     */
+
+    ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
+    ipPtr = ipFirstPtr;
+    if (ipPtr->libraryPtr == libraryPtr) {
+	ipFirstPtr = ipFirstPtr->nextPtr;
+    } else {
+	InterpLibrary *ipPrevPtr;
+
+	for (ipPrevPtr = ipPtr; ipPtr != NULL;
+		ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) {
+	    if (ipPtr->libraryPtr == libraryPtr) {
+		ipPrevPtr->nextPtr = ipPtr->nextPtr;
+		break;
+	    }
+	}
+    }
+    ckfree(ipPtr);
+    Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr);
+
+
+    if (IsStatic(libraryPtr)) {
+	goto done;
+    }
+
     /*
-     * The unload function executed fine. Examine the reference count to see
-     * if we unload the DLL.
+     * The unload function was called succesfully.
      */
 
     Tcl_MutexLock(&libraryMutex);
@@ -837,7 +932,7 @@ Tcl_UnloadObjCmd(
 
     code = TCL_OK;
     if (libraryPtr->safeInterpRefCount <= 0 && libraryPtr->interpRefCount <= 0
-	    && !keepLibrary) {
+	    && (unloadProc != NULL) && !keepLibrary) {
 	/*
 	 * Unload the shared library from the application memory...
 	 */
@@ -850,51 +945,29 @@ Tcl_UnloadObjCmd(
 	 * it's been unloaded.
 	 */
 
-	if (libraryPtr->fileName[0] != '\0') {
+	if (!IsStatic(libraryPtr)) {
 	    Tcl_MutexLock(&libraryMutex);
 	    if (Tcl_FSUnloadFile(interp, libraryPtr->loadHandle) == TCL_OK) {
 		/*
 		 * Remove this library from the loaded library cache.
 		 */
 
-		defaultPtr = libraryPtr;
-		if (defaultPtr == firstLibraryPtr) {
+		iterLibraryPtr = libraryPtr;
+		if (iterLibraryPtr == firstLibraryPtr) {
 		    firstLibraryPtr = libraryPtr->nextPtr;
 		} else {
 		    for (libraryPtr = firstLibraryPtr; libraryPtr != NULL;
 			    libraryPtr = libraryPtr->nextPtr) {
-			if (libraryPtr->nextPtr == defaultPtr) {
-			    libraryPtr->nextPtr = defaultPtr->nextPtr;
+			if (libraryPtr->nextPtr == iterLibraryPtr) {
+			    libraryPtr->nextPtr = iterLibraryPtr->nextPtr;
 			    break;
 			}
 		    }
 		}
 
-		/*
-		 * Remove this library from the interpreter's library cache.
-		 */
-
-		ipFirstPtr = (InterpLibrary *)Tcl_GetAssocData(target, "tclLoad", NULL);
-		ipPtr = ipFirstPtr;
-		if (ipPtr->libraryPtr == defaultPtr) {
-		    ipFirstPtr = ipFirstPtr->nextPtr;
-		} else {
-		    InterpLibrary *ipPrevPtr;
-
-		    for (ipPrevPtr = ipPtr; ipPtr != NULL;
-			    ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) {
-			if (ipPtr->libraryPtr == defaultPtr) {
-			    ipPrevPtr->nextPtr = ipPtr->nextPtr;
-			    break;
-			}
-		    }
-		}
-		Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
-			ipFirstPtr);
-		ckfree(defaultPtr->fileName);
-		ckfree(defaultPtr->prefix);
-		ckfree(defaultPtr);
-		ckfree(ipPtr);
+		ckfree(iterLibraryPtr->fileName);
+		ckfree(iterLibraryPtr->prefix);
+		ckfree(iterLibraryPtr);
 		Tcl_MutexUnlock(&libraryMutex);
 	    } else {
 		code = TCL_ERROR;
@@ -911,12 +984,6 @@ Tcl_UnloadObjCmd(
     }
 
   done:
-    Tcl_DStringFree(&pfx);
-    Tcl_DStringFree(&tmp);
-    if (!complain && (code != TCL_OK)) {
-	code = TCL_OK;
-	Tcl_ResetResult(interp);
-    }
     return code;
 }
 
@@ -989,6 +1056,8 @@ Tcl_StaticLibrary(
 	libraryPtr->loadHandle	= NULL;
 	libraryPtr->initProc	= initProc;
 	libraryPtr->safeInitProc	= safeInitProc;
+	libraryPtr->unloadProc = NULL;
+	libraryPtr->safeUnloadProc = NULL;
 	Tcl_MutexLock(&libraryMutex);
 	libraryPtr->nextPtr		= firstLibraryPtr;
 	firstLibraryPtr		= libraryPtr;
@@ -1137,17 +1206,20 @@ TclGetLoadedLibraries(
 
 static void
 LoadCleanupProc(
-    ClientData clientData,	/* Pointer to first InterpLibrary structure
+    TCL_UNUSED(ClientData),	/* Pointer to first InterpLibrary structure
 				 * for interp. */
-    TCL_UNUSED(Tcl_Interp *))
+    Tcl_Interp *interp)
 {
-    InterpLibrary *ipPtr, *nextPtr;
+    InterpLibrary *ipPtr;
+    LoadedLibrary *libraryPtr;
 
-    ipPtr = (InterpLibrary *)clientData;
-    while (ipPtr != NULL) {
-	nextPtr = ipPtr->nextPtr;
-	ckfree(ipPtr);
-	ipPtr = nextPtr;
+    while (1) {
+	ipPtr = (InterpLibrary *)Tcl_GetAssocData(interp, "tclLoad", NULL);
+	if (ipPtr == NULL) {
+	    break;
+	}
+	libraryPtr = ipPtr->libraryPtr;
+	UnloadLibrary(interp, interp, libraryPtr, 0 ,"", 1);
     }
 }
 
@@ -1192,7 +1264,7 @@ TclFinalizeLoad(void)
 	 * it has been unloaded.
 	 */
 
-	if (libraryPtr->fileName[0] != '\0') {
+	if (!IsStatic(libraryPtr)) {
 	    Tcl_FSUnloadFile(NULL, libraryPtr->loadHandle);
 	}
 #endif