From 0d6bc7fc83128e570ec80f6849bec9b144714d73 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sat, 15 May 2021 07:55:55 +0000 Subject: Separate library unloading routine from [unload] command processing. --- generic/tclLoad.c | 50 ++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 38 insertions(+), 12 deletions(-) diff --git a/generic/tclLoad.c b/generic/tclLoad.c index c9d1b31..e3a7b26 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,12 @@ 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 UnloadLibrary(Tcl_Interp *interp, Tcl_Interp *target, + LoadedLibrary *library, int keepLibrary, + const char *fullFileName); + /* *---------------------------------------------------------------------- @@ -549,10 +554,8 @@ Tcl_UnloadObjCmd( Tcl_Interp *target; /* Which interpreter to unload from. */ LoadedLibrary *libraryPtr, *defaultPtr; 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[] = { @@ -741,6 +744,33 @@ Tcl_UnloadObjCmd( goto done; } + code = UnloadLibrary(interp, target, libraryPtr, keepLibrary, fullFileName); + + done: + Tcl_DStringFree(&pfx); + Tcl_DStringFree(&tmp); + if (!complain && (code != TCL_OK)) { + code = TCL_OK; + Tcl_ResetResult(interp); + } + return code; +} + +static int +UnloadLibrary( + Tcl_Interp *interp, + Tcl_Interp *target, + LoadedLibrary *libraryPtr, + int keepLibrary, + const char *fullFileName +) +{ + int code; + InterpLibrary *ipFirstPtr, *ipPtr; + LoadedLibrary *defaultPtr; + int trustedRefCount, safeRefCount; + Tcl_LibraryUnloadProc *unloadProc; + /* * 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 @@ -771,6 +801,9 @@ Tcl_UnloadObjCmd( 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 @@ -889,8 +922,7 @@ Tcl_UnloadObjCmd( } } } - Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, - ipFirstPtr); + Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr); ckfree(defaultPtr->fileName); ckfree(defaultPtr->prefix); ckfree(defaultPtr); @@ -911,12 +943,6 @@ Tcl_UnloadObjCmd( } done: - Tcl_DStringFree(&pfx); - Tcl_DStringFree(&tmp); - if (!complain && (code != TCL_OK)) { - code = TCL_OK; - Tcl_ResetResult(interp); - } return code; } -- cgit v0.12 From 0f818acbb72a2b4792acb1d82f051507c76e59a2 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sat, 15 May 2021 18:24:59 +0000 Subject: Add valgrind option --keep-deguginfo=yes --- unix/Makefile.in | 1 + 1 file changed, 1 insertion(+) diff --git a/unix/Makefile.in b/unix/Makefile.in index 8bf9def..17e70d9 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -268,6 +268,7 @@ TRACE_OPTS = VALGRIND = valgrind VALGRINDARGS = --tool=memcheck --num-callers=24 \ --leak-resolution=high --leak-check=yes --show-reachable=yes -v \ + --keep-debuginfo=yes \ --suppressions=$(TOOL_DIR)/valgrind_suppress #-------------------------------------------------------------------------- -- cgit v0.12 From 1134511a980250dfb27153be57b4e64e8455cdfe Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sat, 15 May 2021 18:42:40 +0000 Subject: When deleting an interp, delete associated data after running the corresponding Tcl_InterpDeleteProc instead of before to allow the Tcl_InterpDeleteProc to make use of the data. In TcltestObj.c/VarPtrDeleteProc, remove call to Tcl_DeleteAssocData that is redundant and cylic. --- generic/tclBasic.c | 14 +++++++------- generic/tclTestObj.c | 1 - 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 5ca70d4..2d10812 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -1826,28 +1826,28 @@ DeleteInterpProc( ckfree(hTablePtr); } - /* - * Invoke deletion callbacks; note that a callback can create new - * callbacks, so we iterate. - */ - while (iPtr->assocData != NULL) { + if (iPtr->assocData != NULL) { AssocData *dPtr; hTablePtr = iPtr->assocData; - iPtr->assocData = NULL; + /* + * Invoke deletion callbacks; note that a callback can create new + * callbacks, so we iterate. + */ for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search); hPtr != NULL; hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) { dPtr = (AssocData *)Tcl_GetHashValue(hPtr); - Tcl_DeleteHashEntry(hPtr); if (dPtr->proc != NULL) { dPtr->proc(dPtr->clientData, interp); } + Tcl_DeleteHashEntry(hPtr); ckfree(dPtr); } Tcl_DeleteHashTable(hTablePtr); ckfree(hTablePtr); + iPtr->assocData = NULL; } /* diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 17546a4..4e7cec9 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -61,7 +61,6 @@ static void VarPtrDeleteProc(void *clientData, Tcl_Interp *interp) for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) { if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]); } - Tcl_DeleteAssocData(interp, VARPTR_KEY); ckfree(varPtr); } -- cgit v0.12 From 7ee82af4aa11b02822159875e976d1469492e937 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sat, 15 May 2021 21:56:03 +0000 Subject: Fix [28027d8bb7745fb0], memory leaks in tclUnload.c, --- generic/tclLoad.c | 120 ++++++++++++++++++++++++++++++-------------------- tests/pkgMkIndex.test | 4 +- unix/dltest/pkgua.c | 20 ++++++--- 3 files changed, 91 insertions(+), 53 deletions(-) diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 514d3c8..3d64edb 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -96,11 +96,19 @@ typedef struct InterpLibrary { 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); + const char *fullFileName, int interpExiting); +static int +IsStatic (LoadedLibrary *libraryPtr) { + int res; + res = (libraryPtr->fileName[0] == '\0'); + return res; +} + /* *---------------------------------------------------------------------- * @@ -649,7 +657,7 @@ 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); @@ -744,7 +752,7 @@ Tcl_UnloadObjCmd( goto done; } - code = UnloadLibrary(interp, target, libraryPtr, keepLibrary, fullFileName); + code = UnloadLibrary(interp, target, libraryPtr, keepLibrary, fullFileName, 0); done: Tcl_DStringFree(&pfx); @@ -762,14 +770,15 @@ UnloadLibrary( Tcl_Interp *target, LoadedLibrary *libraryPtr, int keepLibrary, - const char *fullFileName + const char *fullFileName, + int interpExiting ) { int code; InterpLibrary *ipFirstPtr, *ipPtr; LoadedLibrary *defaultPtr; - int trustedRefCount, safeRefCount; - Tcl_LibraryUnloadProc *unloadProc; + int trustedRefCount = -1, safeRefCount = -1; + Tcl_LibraryUnloadProc *unloadProc = NULL; /* * Ensure that the DLL can be unloaded. If it is a trusted interpreter, @@ -779,31 +788,34 @@ UnloadLibrary( 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 @@ -814,24 +826,30 @@ UnloadLibrary( * 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; @@ -857,16 +875,20 @@ UnloadLibrary( } } } - Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, - ipFirstPtr); + 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. */ + Tcl_MutexLock(&libraryMutex); if (Tcl_IsSafe(target)) { libraryPtr->safeInterpRefCount--; @@ -908,7 +930,7 @@ UnloadLibrary( * it's been unloaded. */ - if (libraryPtr->fileName[0] != '\0') { + if (!IsStatic(libraryPtr)) { Tcl_MutexLock(&libraryMutex); if (Tcl_FSUnloadFile(interp, libraryPtr->loadHandle) == TCL_OK) { /* @@ -931,7 +953,6 @@ UnloadLibrary( ckfree(defaultPtr->fileName); ckfree(defaultPtr->prefix); ckfree(defaultPtr); - ckfree(ipPtr); Tcl_MutexUnlock(&libraryMutex); } else { code = TCL_ERROR; @@ -1020,6 +1041,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; @@ -1170,15 +1193,18 @@ static void LoadCleanupProc( ClientData 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); } } @@ -1223,7 +1249,7 @@ TclFinalizeLoad(void) * it has been unloaded. */ - if (libraryPtr->fileName[0] != '\0') { + if (!IsStatic(libraryPtr)) { Tcl_FSUnloadFile(NULL, libraryPtr->loadHandle); } #endif diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test index df49c32..002efcc 100644 --- a/tests/pkgMkIndex.test +++ b/tests/pkgMkIndex.test @@ -577,19 +577,21 @@ test pkgMkIndex-10.1 {package in DLL and script} [list exec $dll] { exec [interpreter] << $cmd pkgtest::runCreatedIndex {0 {}} -lazy $fullPkgPath pkga[info sharedlibextension] pkga.tcl } "0 {{pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}" + test pkgMkIndex-10.2 {package in DLL hidden by -load} [list exec $dll] { # Do all [load]ing of shared libraries in another process, so we can # delete the file and not get stuck because we're holding a reference to # it. # # This test depends on context from prior test, so repeat it. + set script \ "[list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]" append script \n \ "[list pkg_mkIndex -lazy -load Pkg* $fullPkgPath [file tail $x]]" exec [interpreter] << $script pkgtest::runCreatedIndex {0 {}} -lazy -load Pkg* -- $fullPkgPath pkga[info sharedlibextension] -} {0 {}} +} {0 {{pkga:1.0 {tclPkgSetup {pkga.so load {pkga_eq pkga_quote}}}}}} if {[testConstraint $dll]} { file delete -force [file join $fullPkgPath [file tail $x]] diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index 0ab3e23..7082b36 100644 --- a/unix/dltest/pkgua.c +++ b/unix/dltest/pkgua.c @@ -21,6 +21,7 @@ static int PkguaEqObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int PkguaQuoteObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static void CommandDeleted(ClientData clientData); /* * In the following hash table we are going to store a struct that holds all @@ -40,6 +41,13 @@ static int interpTokenMapInitialised = 0; static void +CommandDeleted(ClientData clientData) +{ + Tcl_Command *cmdToken = clientData; + *cmdToken = NULL; +} + +static void PkguaInitTokensHashTable(void) { if (interpTokenMapInitialised) { @@ -221,12 +229,14 @@ Pkgua_Init( Tcl_SetVar2(interp, "::pkgua_loaded", NULL, ".", TCL_APPEND_VALUE); cmdTokens = PkguaInterpToTokens(interp); - cmdTokens[cmdIndex++] = - Tcl_CreateObjCommand(interp, "pkgua_eq", PkguaEqObjCmd, NULL, - NULL); - cmdTokens[cmdIndex++] = + cmdTokens[cmdIndex] = + Tcl_CreateObjCommand(interp, "pkgua_eq", PkguaEqObjCmd, &cmdTokens[cmdIndex], + CommandDeleted); + cmdIndex++; + cmdTokens[cmdIndex] = Tcl_CreateObjCommand(interp, "pkgua_quote", PkguaQuoteObjCmd, - NULL, NULL); + &cmdTokens[cmdIndex], CommandDeleted); + cmdIndex++; return TCL_OK; } -- cgit v0.12 From 3634214bbb26d84ee5eebc626e98c33decf178f8 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sun, 16 May 2021 10:03:55 +0000 Subject: Eliminate compiler warnings about unused parameters. --- generic/tclLoad.c | 24 ++++++++++-------------- generic/tclTestObj.c | 2 +- generic/tclZipfs.c | 2 +- 3 files changed, 12 insertions(+), 16 deletions(-) diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 3d64edb..ed2be03 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -560,7 +560,7 @@ 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; InterpLibrary *ipFirstPtr, *ipPtr; int i, index, code, complain = 1, keepLibrary = 0; @@ -662,7 +662,6 @@ Tcl_UnloadObjCmd( Tcl_MutexLock(&libraryMutex); - defaultPtr = NULL; for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) { int namesMatch, filesMatch; @@ -688,9 +687,6 @@ Tcl_UnloadObjCmd( if (filesMatch && (namesMatch || (prefix == NULL))) { break; } - if (namesMatch && (fullFileName[0] == 0)) { - defaultPtr = libraryPtr; - } if (filesMatch && !namesMatch && (fullFileName[0] != 0)) { break; } @@ -776,7 +772,7 @@ UnloadLibrary( { int code; InterpLibrary *ipFirstPtr, *ipPtr; - LoadedLibrary *defaultPtr; + LoadedLibrary *iterLibraryPtr; int trustedRefCount = -1, safeRefCount = -1; Tcl_LibraryUnloadProc *unloadProc = NULL; @@ -937,22 +933,22 @@ UnloadLibrary( * 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; } } } - ckfree(defaultPtr->fileName); - ckfree(defaultPtr->prefix); - ckfree(defaultPtr); + ckfree(iterLibraryPtr->fileName); + ckfree(iterLibraryPtr->prefix); + ckfree(iterLibraryPtr); Tcl_MutexUnlock(&libraryMutex); } else { code = TCL_ERROR; @@ -1191,7 +1187,7 @@ TclGetLoadedLibraries( static void LoadCleanupProc( - ClientData clientData, /* Pointer to first InterpLibrary structure + TCL_UNUSED(ClientData), /* Pointer to first InterpLibrary structure * for interp. */ Tcl_Interp *interp) { diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 4e7cec9..f766030 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -54,7 +54,7 @@ static Tcl_ObjCmdProc TeststringobjCmd; #define VARPTR_KEY "TCLOBJTEST_VARPTR" #define NUMBER_OF_OBJECT_VARS 20 -static void VarPtrDeleteProc(void *clientData, Tcl_Interp *interp) +static void VarPtrDeleteProc(void *clientData, TCL_UNUSED(Tcl_Interp *)) { int i; Tcl_Obj **varPtr = (Tcl_Obj **) clientData; diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index bad4cb9..399aa65 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -5733,7 +5733,7 @@ ZipfsAppHookFindTclInit( static void ZipfsExitHandler( - ClientData clientData) + TCL_UNUSED(ClientData)) { Tcl_HashEntry *hPtr; Tcl_HashSearch search; -- cgit v0.12 From d4d8fe187b4352bb54fced2e2ba5c6ebbb1f62d8 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Mon, 17 May 2021 07:39:20 +0000 Subject: use [info sharedlibextension] for instead of ".so" --- tests/pkgMkIndex.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test index 002efcc..f01f497 100644 --- a/tests/pkgMkIndex.test +++ b/tests/pkgMkIndex.test @@ -591,7 +591,7 @@ test pkgMkIndex-10.2 {package in DLL hidden by -load} [list exec $dll] { "[list pkg_mkIndex -lazy -load Pkg* $fullPkgPath [file tail $x]]" exec [interpreter] << $script pkgtest::runCreatedIndex {0 {}} -lazy -load Pkg* -- $fullPkgPath pkga[info sharedlibextension] -} {0 {{pkga:1.0 {tclPkgSetup {pkga.so load {pkga_eq pkga_quote}}}}}} +} "0 {{pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}}}}}" if {[testConstraint $dll]} { file delete -force [file join $fullPkgPath [file tail $x]] -- cgit v0.12