diff options
| -rw-r--r-- | generic/tclEnv.c | 1 | ||||
| -rw-r--r-- | generic/tclInt.h | 18 | ||||
| -rw-r--r-- | generic/tclOO.c | 15 | ||||
| -rw-r--r-- | tests/oo.test | 18 | ||||
| -rw-r--r-- | win/tclWinLoad.c | 10 |
5 files changed, 52 insertions, 10 deletions
diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 66ddb57..8cc4b74 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -130,6 +130,7 @@ TclSetupEnv( * '='; ignore the entry. */ + Tcl_DStringFree(&envString); continue; } p2++; diff --git a/generic/tclInt.h b/generic/tclInt.h index 0b5ff0c..0d68e8e 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2445,8 +2445,8 @@ typedef struct List { #define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */ /* - * Macros providing a faster path to integers: Tcl_GetLongFromObj everywhere, - * Tcl_GetIntFromObj and TclGetIntForIndex on platforms where longs are ints. + * Macros providing a faster path to integers: Tcl_GetLongFromObj, + * Tcl_GetIntFromObj and TclGetIntForIndex. * * WARNING: these macros eval their args more than once. */ @@ -2467,9 +2467,17 @@ typedef struct List { : TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) #else #define TclGetIntFromObj(interp, objPtr, intPtr) \ - Tcl_GetIntFromObj((interp), (objPtr), (intPtr)) -#define TclGetIntForIndexM(interp, objPtr, ignore, idxPtr) \ - TclGetIntForIndex(interp, objPtr, ignore, idxPtr) + (((objPtr)->typePtr == &tclIntType \ + && (objPtr)->internalRep.longValue >= -(Tcl_WideInt)(UINT_MAX) \ + && (objPtr)->internalRep.longValue <= (Tcl_WideInt)(UINT_MAX)) \ + ? ((*(intPtr) = (objPtr)->internalRep.longValue), TCL_OK) \ + : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) +#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \ + (((objPtr)->typePtr == &tclIntType \ + && (objPtr)->internalRep.longValue >= INT_MIN \ + && (objPtr)->internalRep.longValue <= INT_MAX) \ + ? ((*(idxPtr) = (objPtr)->internalRep.longValue), TCL_OK) \ + : TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) #endif /* diff --git a/generic/tclOO.c b/generic/tclOO.c index e9ef2ce..51731d3 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -1006,8 +1006,18 @@ ReleaseClassContents( } for(j=0 ; j<instancePtr->mixins.num ; j++) { Class *mixin = instancePtr->mixins.list[j]; + Class *nextMixin = NULL; if (mixin == clsPtr) { - instancePtr->mixins.list[j] = NULL; + if (j < instancePtr->mixins.num - 1) { + nextMixin = instancePtr->mixins.list[j+1]; + } + if (j == 0) { + instancePtr->mixins.num = 0; + instancePtr->mixins.list = NULL; + } else { + instancePtr->mixins.list[j-1] = nextMixin; + } + instancePtr->mixins.num -= 1; } } if (instancePtr != NULL && !IsRoot(instancePtr)) { @@ -1181,7 +1191,8 @@ ObjectNamespaceDeleted( if ((((Command *)oPtr->command)->flags && CMD_IS_DELETED)) { /* * Namespace deletion must have been triggered by a trace on command - * deletion , meaning that + * deletion , meaning that ObjectRenamedTrace() is eventually going + * to be called . */ deleteAlreadyInProgress = 1; } diff --git a/tests/oo.test b/tests/oo.test index 6413094..b6af1ee 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -1495,6 +1495,24 @@ test oo-11.5 {OO: cleanup} { return done } done +test oo-11.6 { + OO: cleanup ReleaseClassContents() where class is mixed into one of its + instances +} { + oo::class create obj1 + ::oo::define obj1 {self mixin [self]} + + ::oo::copy obj1 obj2 + ::oo::objdefine obj2 {mixin [self]} + + ::oo::copy obj2 obj3 + trace add command obj3 delete [list obj3 dying] + rename obj2 {} + + # No segmentation fault + return done +} done + test oo-12.1 {OO: filters} { oo::class create Aclass Aclass create Aobject diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index 27eb8f3..69263e9 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -63,7 +63,7 @@ TclpDlopen( * file. */ int flags) { - HINSTANCE hInstance; + HINSTANCE hInstance = NULL; const TCHAR *nativeName; Tcl_LoadHandle handlePtr; DWORD firstError; @@ -75,7 +75,10 @@ TclpDlopen( */ nativeName = Tcl_FSGetNativePath(pathPtr); - hInstance = LoadLibraryEx(nativeName,NULL,LOAD_WITH_ALTERED_SEARCH_PATH); + if (nativeName != NULL) { + hInstance = LoadLibraryEx(nativeName, NULL, + LOAD_WITH_ALTERED_SEARCH_PATH); + } if (hInstance == NULL) { /* * Let the OS loader examine the binary search path for whatever @@ -89,7 +92,8 @@ TclpDlopen( * Remember the first error on load attempt to be used if the * second load attempt below also fails. */ - firstError = GetLastError(); + firstError = (nativeName == NULL) ? + ERROR_MOD_NOT_FOUND : GetLastError(); nativeName = Tcl_WinUtfToTChar(Tcl_GetString(pathPtr), -1, &ds); hInstance = LoadLibraryEx(nativeName, NULL, |