summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog4
-rw-r--r--generic/tclFileSystem.h7
-rw-r--r--generic/tclIOUtil.c14
-rw-r--r--generic/tclPathObj.c51
-rw-r--r--library/dde/pkgIndex.tcl2
-rw-r--r--library/platform/shell.tcl2
-rwxr-xr-xlibrary/reg/pkgIndex.tcl2
-rw-r--r--tests/safe.test14
-rw-r--r--win/tclWinReg.c2
9 files changed, 39 insertions, 59 deletions
diff --git a/ChangeLog b/ChangeLog
index 04407b7..1ae8ec4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2012-06-19 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinReg.c: Plug memory leak, part of [Bug #3362446]
+
2012-06-11 Don Porter <dgp@users.sourceforge.net>
* generic/tclBasic.c: [Bug 3532959] Make sure the lifetime management
diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h
index 97e73fe..e11ac16 100644
--- a/generic/tclFileSystem.h
+++ b/generic/tclFileSystem.h
@@ -64,10 +64,9 @@ typedef struct ThreadSpecificData {
MODULE_SCOPE int TclFSCwdPointerEquals(Tcl_Obj **pathPtrPtr);
MODULE_SCOPE int TclFSMakePathFromNormalized(Tcl_Interp *interp,
- Tcl_Obj *pathPtr, ClientData clientData);
+ Tcl_Obj *pathPtr);
MODULE_SCOPE int TclFSNormalizeToUniquePath(Tcl_Interp *interp,
- Tcl_Obj *pathPtr, int startAt,
- ClientData *clientDataPtr);
+ Tcl_Obj *pathPtr, int startAt);
MODULE_SCOPE Tcl_Obj * TclFSMakePathRelative(Tcl_Interp *interp,
Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr);
MODULE_SCOPE Tcl_Obj * TclFSInternalToNormalized(
@@ -80,7 +79,7 @@ MODULE_SCOPE void TclFSSetPathDetails(Tcl_Obj *pathPtr,
FilesystemRecord *fsRecPtr,
ClientData clientData);
MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
- Tcl_Obj *pathPtr, ClientData *clientDataPtr);
+ Tcl_Obj *pathPtr);
/*
* Private shared variables for use by tclIOUtil.c and tclPathObj.c
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 80eccbf..0600a6c 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -1447,14 +1447,9 @@ int
TclFSNormalizeToUniquePath(
Tcl_Interp *interp, /* Used for error messages. */
Tcl_Obj *pathPtr, /* The path to normalize in place */
- int startAt, /* Start at this char-offset */
- ClientData *clientDataPtr) /* If we generated a complete normalized path
- * for a given filesystem, we can optionally
- * return an fs-specific clientdata here. */
+ int startAt) /* Start at this char-offset */
{
FilesystemRecord *fsRecPtr, *firstFsRecPtr;
- /* Ignore this variable */
- (void) clientDataPtr;
/*
* Call each of the "normalise path" functions in succession. This is a
@@ -2708,7 +2703,7 @@ Tcl_FSGetCwd(
retVal = (*fsRecPtr->fsPtr->internalToNormalizedProc)(
retCd);
Tcl_IncrRefCount(retVal);
- norm = TclFSNormalizeAbsolutePath(interp,retVal,NULL);
+ norm = TclFSNormalizeAbsolutePath(interp,retVal);
if (norm != NULL) {
/*
* We found a cwd, which is now in our global
@@ -2756,7 +2751,7 @@ Tcl_FSGetCwd(
*/
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. We must
@@ -2824,8 +2819,7 @@ Tcl_FSGetCwd(
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
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index cde554c..147c619 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -152,14 +152,8 @@ typedef struct FsPath {
Tcl_Obj *
TclFSNormalizeAbsolutePath(
Tcl_Interp *interp, /* Interpreter to use */
- Tcl_Obj *pathPtr, /* Absolute path to normalize */
- ClientData *clientDataPtr) /* If non-NULL, then may be set to the
- * fs-specific clientData for this path. This
- * will happen when that extra information can
- * be calculated efficiently as a side-effect
- * of normalization. */
+ Tcl_Obj *pathPtr) /* Absolute path to normalize */
{
- ClientData clientData = NULL;
const char *dirSep, *oldDirSep;
int first = 1; /* Set to zero once we've passed the first
* directory separator - we can't use '..' to
@@ -432,17 +426,14 @@ TclFSNormalizeAbsolutePath(
* for normalizing a path.
*/
- 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 FsPath for greater efficiency
*/
- TclFSMakePathFromNormalized(interp, retVal, clientData);
- if (clientDataPtr != NULL) {
- *clientDataPtr = clientData;
- }
+ TclFSMakePathFromNormalized(interp, retVal);
/*
* This has a refCount of 1 for the caller, unlike many Tcl_Obj APIs.
@@ -1558,9 +1549,7 @@ TclFSMakePathRelative(
int
TclFSMakePathFromNormalized(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
- Tcl_Obj *pathPtr, /* The object to convert. */
- ClientData nativeRep) /* The native rep for the object, if known
- * else NULL. */
+ Tcl_Obj *pathPtr) /* The object to convert. */
{
FsPath *fsPathPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
@@ -1602,7 +1591,7 @@ TclFSMakePathFromNormalized(
fsPathPtr->normPathPtr = pathPtr;
fsPathPtr->cwdPtr = NULL;
- fsPathPtr->nativePathPtr = nativeRep;
+ fsPathPtr->nativePathPtr = NULL;
fsPathPtr->fsRecPtr = NULL;
fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
@@ -1844,7 +1833,6 @@ Tcl_FSGetNormalizedPath(
Tcl_Obj *dir, *copy;
int cwdLen, pathType;
- ClientData clientData = NULL;
pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr);
@@ -1877,7 +1865,7 @@ Tcl_FSGetNormalizedPath(
* we avoid [Bug 2385549] ...
*/
- Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy, NULL);
+ Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy);
Tcl_DecrRefCount(copy);
copy = newCopy;
} else {
@@ -1892,8 +1880,7 @@ Tcl_FSGetNormalizedPath(
* 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. */
@@ -1936,15 +1923,6 @@ Tcl_FSGetNormalizedPath(
TclDecrRefCount(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(pathPtr) = 0;
}
@@ -1965,7 +1943,6 @@ Tcl_FSGetNormalizedPath(
} else if (fsPathPtr->normPathPtr == NULL) {
int cwdLen;
Tcl_Obj *copy;
- ClientData clientData = NULL;
copy = AppendPath(fsPathPtr->cwdPtr, pathPtr);
@@ -1977,17 +1954,12 @@ Tcl_FSGetNormalizedPath(
* 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;
Tcl_IncrRefCount(fsPathPtr->normPathPtr);
- if (clientData != NULL) {
- fsPathPtr->nativePathPtr = clientData;
- }
}
}
if (fsPathPtr->normPathPtr == NULL) {
- ClientData clientData = NULL;
Tcl_Obj *useThisCwd = NULL;
int pureNormalized = 1;
@@ -2069,12 +2041,7 @@ Tcl_FSGetNormalizedPath(
*/
fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp,
- absolutePath,
- (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
- if (0 && (clientData != NULL)) {
- fsPathPtr->nativePathPtr =
- (*fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc)(clientData);
- }
+ absolutePath);
/*
* Check if path is pure normalized (this can only be the case if it
diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl
index 96d5855..114dee6 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.3.3 [list load [file join $dir tcldde13g.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 6fa8eda..4b269e6 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.2.1 \
[list load [file join $dir tclreg12g.dll] registry]
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";
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index f2ac367..13216f3 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -671,6 +671,8 @@ GetKeyNames(
}
if (result == TCL_OK) {
Tcl_SetObjResult(interp, resultPtr);
+ } else {
+ Tcl_DecrRefCount(resultPtr); /* BUGFIX: Don't leak on failure. */
}
ckfree(buffer);
generated by cgit v0.12 at 2024-11-10 06:12:18 (GMT)