From b1856533641e3211ef6e5b973ef1b0ea065c20ea Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 12 Jun 2012 12:35:18 +0000 Subject: add test that triggered reporting of [Bug 3530230] --- tests/safe.test | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/tests/safe.test b/tests/safe.test index 4bd8509..8879518 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -309,6 +309,20 @@ test safe-8.9 {safe source and return} -setup { catch {safe::interpDelete $i} removeFile $returnScript } -result ok +test safe-8.10 {safe source and return} -setup { + set returnScript [makeFile {return -level 2 "ok"} return.tcl] + catch {safe::interpDelete $i} +} -body { + safe::interpCreate $i + set token [safe::interpAddToAccessPath $i [file dirname $returnScript]] + $i eval [list apply {filename { + source $filename + error boom + }} $token/[file tail $returnScript]] +} -cleanup { + catch {safe::interpDelete $i} + removeFile $returnScript +} -result ok test safe-9.1 {safe interps' deleteHook} { set i "a"; -- cgit v0.12 From 9e832d51f5cf8e1317b58eae1f0b7ded6e0b198d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 14 Jun 2012 07:27:05 +0000 Subject: more readable --- library/dde/pkgIndex.tcl | 2 +- library/platform/shell.tcl | 2 +- library/reg/pkgIndex.tcl | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl index db67e98..1450276 100644 --- a/library/dde/pkgIndex.tcl +++ b/library/dde/pkgIndex.tcl @@ -1,5 +1,5 @@ if {![package vsatisfies [package provide Tcl] 8]} return -if {[string compare [info sharedlibextension] .dll]} return +if {[info sharedlibextension] != ".dll"} return if {[info exists ::tcl_platform(debug)]} { package ifneeded dde 1.2.5 [list load [file join $dir tcldde12g.dll] dde] } else { diff --git a/library/platform/shell.tcl b/library/platform/shell.tcl index e0a129a..d37cdcd 100644 --- a/library/platform/shell.tcl +++ b/library/platform/shell.tcl @@ -187,7 +187,7 @@ proc ::platform::shell::TEMP {} { } } } - if {[string compare $channel ""]} { + if {$channel != ""} { return -code error "Failed to open a temporary file: $channel" } else { return -code error "Failed to find an unused temporary file name" diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl index 35b1143..40032a5 100755 --- a/library/reg/pkgIndex.tcl +++ b/library/reg/pkgIndex.tcl @@ -1,5 +1,5 @@ if {![package vsatisfies [package provide Tcl] 8]} return -if {[string compare [info sharedlibextension] .dll]} return +if {[info sharedlibextension] != ".dll"} return if {[info exists ::tcl_platform(debug)]} { package ifneeded registry 1.1.5 \ [list load [file join $dir tclreg11g.dll] registry] -- cgit v0.12 From b4274908c29bc7b8e88b1af0b34ba947453ccdbc Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 19 Jun 2012 14:55:42 +0000 Subject: Plug memory leak, part of [Bug #3362446] --- ChangeLog | 4 ++++ win/tclWinReg.c | 2 ++ 2 files changed, 6 insertions(+) diff --git a/ChangeLog b/ChangeLog index 6b9c072..5d4d5b9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2012-06-19 Jan Nijtmans + + * win/tclWinReg.c: Plug memory leak, part of [Bug #3362446] + 2012-06-08 Don Porter * unix/configure.in: Update autogoo for gettimeofday(). diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 3960fda..7d50996 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -595,6 +595,8 @@ GetKeyNames( } if (result == TCL_OK) { Tcl_SetObjResult(interp, resultPtr); + } else { + Tcl_DecrRefCount(resultPtr); /* BUGFIX: Don't leak on failure. */ } ckfree(buffer); -- cgit v0.12 From 72e0260dd8c56fb8041518ded09189144ab90b74 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 20 Jun 2012 17:41:09 +0000 Subject: Remove dead code that complicates fs path values but adds no value. --- generic/tclIOUtil.c | 41 ++++++++++------------------------------- 1 file changed, 10 insertions(+), 31 deletions(-) diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 40f3f76..bb82d32 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -68,9 +68,9 @@ typedef struct FilesystemRecord { int TclFSCwdPointerEquals _ANSI_ARGS_((Tcl_Obj* objPtr)); int TclFSMakePathFromNormalized _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *objPtr, ClientData clientData)); + Tcl_Obj *objPtr)); int TclFSNormalizeToUniquePath _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *pathPtr, int startAt, ClientData *clientDataPtr)); + Tcl_Obj *pathPtr, int startAt)); Tcl_Obj* TclFSMakePathRelative _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *cwdPtr)); Tcl_Obj* TclFSInternalToNormalized _ANSI_ARGS_(( @@ -1376,8 +1376,6 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) } } if (nplen > 0) { - ClientData clientData = NULL; - retVal = Tcl_FSJoinPath(split, nplen); /* * Now we have an absolute path, with no '..', '.' sequences, @@ -1391,15 +1389,15 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) * other criteria for normalizing a path. */ Tcl_IncrRefCount(retVal); - TclFSNormalizeToUniquePath(interp, retVal, 0, &clientData); + TclFSNormalizeToUniquePath(interp, retVal, 0); /* * Since we know it is a normalized path, we can * actually convert this object into an "path" object for * greater efficiency */ - TclFSMakePathFromNormalized(interp, retVal, clientData); + TclFSMakePathFromNormalized(interp, retVal); if (clientDataPtr != NULL) { - *clientDataPtr = clientData; + *clientDataPtr = NULL; } } else { /* Init to an empty string */ @@ -1456,15 +1454,13 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) *--------------------------------------------------------------------------- */ int -TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr) +TclFSNormalizeToUniquePath(interp, pathPtr, startAt) Tcl_Interp *interp; Tcl_Obj *pathPtr; int startAt; - ClientData *clientDataPtr; { FilesystemRecord *fsRecPtr, *firstFsRecPtr; /* Ignore this variable */ - (void)clientDataPtr; /* * Call each of the "normalise path" functions in succession. This is @@ -5347,11 +5343,9 @@ TclFSMakePathRelative(interp, objPtr, cwdPtr) */ int -TclFSMakePathFromNormalized(interp, objPtr, nativeRep) +TclFSMakePathFromNormalized(interp, objPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr; /* The object to convert. */ - ClientData nativeRep; /* The native rep for the object, if known - * else NULL. */ { FsPath *fsPathPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -5383,7 +5377,7 @@ TclFSMakePathFromNormalized(interp, objPtr, nativeRep) fsPathPtr->translatedPathPtr = NULL; fsPathPtr->normPathPtr = objPtr; fsPathPtr->cwdPtr = NULL; - fsPathPtr->nativePathPtr = nativeRep; + fsPathPtr->nativePathPtr = NULL; fsPathPtr->fsRecPtr = NULL; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; @@ -5618,7 +5612,6 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) int cwdLen; int pathType; CONST char *cwdStr; - ClientData clientData = NULL; pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr); @@ -5688,8 +5681,7 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) * after that separator. */ - TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, - (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); + TclFSNormalizeToUniquePath(interp, copy, cwdLen-1); } /* Now we need to construct the new path object */ @@ -5715,14 +5707,6 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) /* That's our reference to copy used */ Tcl_DecrRefCount(dir); } - if (clientData != NULL) { - /* - * This may be unnecessary. It appears that the - * TclFSNormalizeToUniquePath call above should have already - * set this up. Not changing out of fear of the unknown. - */ - fsPathPtr->nativePathPtr = clientData; - } PATHFLAGS(pathObjPtr) = 0; } /* Ensure cwd hasn't changed */ @@ -5742,7 +5726,6 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) int cwdLen; Tcl_Obj *copy; CONST char *cwdStr; - ClientData clientData = NULL; copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr); Tcl_IncrRefCount(copy); @@ -5780,12 +5763,8 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) * the end of the previously normalized 'dir'. This should * be much faster! */ - TclFSNormalizeToUniquePath(interp, copy, cwdLen-1, - (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); + TclFSNormalizeToUniquePath(interp, copy, cwdLen-1); fsPathPtr->normPathPtr = copy; - if (clientData != NULL) { - fsPathPtr->nativePathPtr = clientData; - } } } if (fsPathPtr->normPathPtr == NULL) { -- cgit v0.12 From 52d15b52d02ef41a6a25128de9bd49c2fc59b343 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 20 Jun 2012 18:22:30 +0000 Subject: ...and one more line. --- generic/tclIOUtil.c | 1 - 1 file changed, 1 deletion(-) diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index bb82d32..b6f89d9 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -1460,7 +1460,6 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt) int startAt; { FilesystemRecord *fsRecPtr, *firstFsRecPtr; - /* Ignore this variable */ /* * Call each of the "normalise path" functions in succession. This is -- cgit v0.12 From 38f0b4d80988173806607621adbf9258d555f033 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 20 Jun 2012 19:36:13 +0000 Subject: Purge more dead fs path code. --- generic/tclIOUtil.c | 24 +++++++----------------- 1 file changed, 7 insertions(+), 17 deletions(-) diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index b6f89d9..94d0a6c 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -98,8 +98,7 @@ static Tcl_PathType GetPathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr, int *driveNameLengthPtr, Tcl_Obj **driveNameRef)); static Tcl_FSPathInFilesystemProc NativePathInFilesystem; static Tcl_Obj* TclFSNormalizeAbsolutePath - _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr, - ClientData *clientDataPtr)); + _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr)); /* * Prototypes for procedures defined later in this file. */ @@ -1337,10 +1336,9 @@ Tcl_FSData(fsPtr) *--------------------------------------------------------------------------- */ static Tcl_Obj * -TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) +TclFSNormalizeAbsolutePath(interp, pathPtr) Tcl_Interp* interp; /* Interpreter to use */ Tcl_Obj *pathPtr; /* Absolute path to normalize */ - ClientData *clientDataPtr; { int splen = 0, nplen, eltLen, i; char *eltName; @@ -1396,9 +1394,6 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) * greater efficiency */ TclFSMakePathFromNormalized(interp, retVal); - if (clientDataPtr != NULL) { - *clientDataPtr = NULL; - } } else { /* Init to an empty string */ retVal = Tcl_NewStringObj("",0); @@ -2538,7 +2533,7 @@ Tcl_FSGetCwd(interp) * could be problematic. */ if (retVal != NULL) { - Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL); + Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal); if (norm != NULL) { /* * We found a cwd, which is now in our global storage. @@ -2580,7 +2575,7 @@ Tcl_FSGetCwd(interp) if (proc != NULL) { Tcl_Obj *retVal = (*proc)(interp); if (retVal != NULL) { - Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL); + Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal); /* * Check whether cwd has changed from the value * previously stored in cwdPathPtr. Really 'norm' @@ -5665,7 +5660,7 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) * we avoid [Bug 2385549] ... */ - Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy, NULL); + Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy); Tcl_DecrRefCount(copy); copy = newCopy; } else { @@ -5767,7 +5762,6 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) } } if (fsPathPtr->normPathPtr == NULL) { - ClientData clientData = NULL; Tcl_Obj *useThisCwd = NULL; /* * Since normPathPtr is NULL, but this is a valid path @@ -5854,12 +5848,8 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) } } /* Already has refCount incremented */ - fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, absolutePath, - (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL)); - if (0 && (clientData != NULL)) { - fsPathPtr->nativePathPtr = - (*fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc)(clientData); - } + fsPathPtr->normPathPtr + = TclFSNormalizeAbsolutePath(interp, absolutePath); if (!strcmp(Tcl_GetString(fsPathPtr->normPathPtr), Tcl_GetString(pathObjPtr))) { /* -- cgit v0.12