summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog4
-rw-r--r--generic/tclIOUtil.c64
-rw-r--r--library/dde/pkgIndex.tcl2
-rw-r--r--library/platform/shell.tcl2
-rwxr-xr-xlibrary/reg/pkgIndex.tcl2
-rw-r--r--unix/tcl.m46
-rw-r--r--unix/tclUnixNotfy.c34
-rw-r--r--win/tclWinReg.c10
8 files changed, 63 insertions, 61 deletions
diff --git a/ChangeLog b/ChangeLog
index 6b9c072..5d4d5b9 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-08 Don Porter <dgp@users.sourceforge.net>
* unix/configure.in: Update autogoo for gettimeofday().
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 40f3f76..94d0a6c 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_((
@@ -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;
@@ -1376,8 +1374,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,16 +1387,13 @@ 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);
- if (clientDataPtr != NULL) {
- *clientDataPtr = clientData;
- }
+ TclFSMakePathFromNormalized(interp, retVal);
} else {
/* Init to an empty string */
retVal = Tcl_NewStringObj("",0);
@@ -1456,15 +1449,12 @@ 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
@@ -2543,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.
@@ -2585,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'
@@ -5347,11 +5337,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 +5371,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 +5606,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);
@@ -5673,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 {
@@ -5688,8 +5675,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 +5701,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 +5720,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,16 +5757,11 @@ 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) {
- ClientData clientData = NULL;
Tcl_Obj *useThisCwd = NULL;
/*
* Since normPathPtr is NULL, but this is a valid path
@@ -5876,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))) {
/*
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]
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 2391a41..7161c91 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -1226,6 +1226,12 @@ dnl AC_CHECK_TOOL(AR, ar)
if test "$ac_cv_cygwin" = "no"; then
AC_MSG_ERROR([${CC} is not a cygwin compiler.])
fi
+ if test "x${TCL_THREADS}" = "x0"; then
+ AC_MSG_ERROR([CYGWIN compile is only supported with --enable-threads])
+ fi
+ if test ! -f "../win/tcldde12.dll" -a ! -f "../win/tk84.dll"; then
+ AC_MSG_ERROR([Please configure and make the ../win directory first.])
+ fi
;;
dgux*)
SHLIB_CFLAGS="-K PIC"
diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
index aff51b1..ab1f160 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.c
@@ -103,10 +103,11 @@ typedef struct ThreadSpecificData {
* that an event is ready to be processed
* by sending this event. */
void *hwnd; /* Messaging window. */
-#endif /* __CYGWIN__ */
+#else /* !__CYGWIN__ */
Tcl_Condition waitCV; /* Any other thread alerts a notifier
* that an event is ready to be processed
* by signaling this condition variable. */
+#endif /* __CYGWIN__ */
int eventReady; /* True if an event is ready to be processed.
* Used as condition flag together with
* waitCV above. */
@@ -354,8 +355,9 @@ Tcl_FinalizeNotifier(clientData)
#ifdef __CYGWIN__
CloseHandle(tsdPtr->event);
-#endif /* __CYGWIN__ */
+#else /* __CYGWIN__ */
Tcl_ConditionFinalize(&(tsdPtr->waitCV));
+#endif /* __CYGWIN__ */
Tcl_MutexUnlock(&notifierMutex);
#endif
@@ -390,7 +392,11 @@ Tcl_AlertNotifier(clientData)
ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
Tcl_MutexLock(&notifierMutex);
tsdPtr->eventReady = 1;
+#ifdef __CYGWIN__
+ PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
+#else
Tcl_ConditionNotify(&tsdPtr->waitCV);
+#endif
Tcl_MutexUnlock(&notifierMutex);
#endif
}
@@ -832,9 +838,7 @@ Tcl_WaitForEvent(timePtr)
class.hIcon = NULL;
class.hCursor = NULL;
- if (!RegisterClassW(&class)) {
- Tcl_Panic("Unable to register TclNotifier window class");
- }
+ RegisterClassW(&class);
tsdPtr->hwnd = CreateWindowExW(NULL, class.lpszClassName, class.lpszClassName,
0, 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL);
tsdPtr->event = CreateEventW(NULL, 1 /* manual */,
@@ -866,7 +870,21 @@ Tcl_WaitForEvent(timePtr)
FD_ZERO( &(tsdPtr->readyMasks.exceptional) );
if (!tsdPtr->eventReady) {
- Tcl_ConditionWait(&tsdPtr->waitCV, &notifierMutex, timePtr);
+#ifdef __CYGWIN__
+ if (!PeekMessageW(&msg, NULL, 0, 0, 0)) {
+ DWORD timeout;
+ if (timePtr) {
+ timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
+ } else {
+ timeout = 0xFFFFFFFF;
+ }
+ Tcl_MutexUnlock(&notifierMutex);
+ MsgWaitForMultipleObjects(1, &tsdPtr->event, 0, timeout, 1279);
+ Tcl_MutexLock(&notifierMutex);
+ }
+#else
+ Tcl_ConditionWait(&tsdPtr->waitCV, &notifierMutex, timePtr);
+#endif
}
tsdPtr->eventReady = 0;
@@ -1159,7 +1177,11 @@ NotifierThreadProc(clientData)
tsdPtr->onList = 0;
tsdPtr->pollState = 0;
}
+#ifdef __CYGWIN__
+ PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
+#else /* __CYGWIN__ */
Tcl_ConditionNotify(&tsdPtr->waitCV);
+#endif /* __CYGWIN__ */
}
}
Tcl_MutexUnlock(&notifierMutex);
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 3960fda..701edfb 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);
@@ -729,8 +731,8 @@ GetValue(
*/
Tcl_DStringInit(&data);
- length = TCL_DSTRING_STATIC_SIZE - 1;
- Tcl_DStringSetLength(&data, (int) length);
+ Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1);
+ length = TCL_DSTRING_STATIC_SIZE / (regWinProcs->useWide ? 2 : 1) - 1;
resultPtr = Tcl_GetObjResult(interp);
@@ -746,8 +748,8 @@ GetValue(
* Required for HKEY_PERFORMANCE_DATA
*/
length *= 2;
- Tcl_DStringSetLength(&data, (int) length);
- result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue,
+ Tcl_DStringSetLength(&data, (int) length * (regWinProcs->useWide ? 2 : 1));
+ result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue,
NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length);
}
Tcl_DStringFree(&buf);
generated by cgit v0.12 at 2024-11-09 19:18:34 (GMT)