summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog90
-rw-r--r--compat/zlib/win32/zlib1.dllbin100352 -> 107520 bytes
-rw-r--r--doc/GetIndex.310
-rw-r--r--generic/tclCmdAH.c16
-rw-r--r--generic/tclEnv.c4
-rw-r--r--generic/tclFileName.c40
-rw-r--r--generic/tclFileSystem.h55
-rw-r--r--generic/tclIOSock.c43
-rw-r--r--generic/tclIOUtil.c232
-rw-r--r--generic/tclInt.decls5
-rw-r--r--generic/tclIntPlatDecls.h10
-rw-r--r--generic/tclPanic.c15
-rw-r--r--generic/tclPathObj.c153
-rw-r--r--generic/tclStubInit.c3
-rw-r--r--library/dde/pkgIndex.tcl2
-rw-r--r--library/msgcat/msgcat.tcl52
-rw-r--r--library/msgcat/pkgIndex.tcl2
-rw-r--r--library/platform/shell.tcl2
-rwxr-xr-xlibrary/reg/pkgIndex.tcl6
-rw-r--r--tests/encoding.test8
-rw-r--r--tests/fCmd.test13
-rw-r--r--tests/fileName.test6
-rw-r--r--tests/msgcat.test4
-rw-r--r--tests/registry.test6
-rw-r--r--unix/Makefile.in23
-rwxr-xr-xunix/configure35
-rw-r--r--unix/configure.in9
-rw-r--r--unix/tcl.m418
-rw-r--r--unix/tclConfig.sh.in2
-rw-r--r--unix/tclUnixFile.c13
-rw-r--r--unix/tclUnixNotfy.c147
-rw-r--r--unix/tclUnixPort.h6
-rw-r--r--unix/tclUnixSock.c20
-rw-r--r--win/Makefile.in4
-rw-r--r--win/tclWinError.c6
-rw-r--r--win/tclWinFile.c10
-rw-r--r--win/tclWinReg.c116
-rw-r--r--win/tclWinSock.c9
38 files changed, 699 insertions, 496 deletions
diff --git a/ChangeLog b/ChangeLog
index 4ac5205..fe75ef4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,9 +1,74 @@
+2012-06-29 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * library/msgcat/msgcat.tcl: Add tn, ro_MO and ru_MO to msgcat.
+
+2012-06-29 Harald Oehlmann <harald.oehlmann@elmicron.de>
+
+ * library/msgcat/msgcat.tcl: [Bug 3536888] Locale guessing of msgcat
+ * library/msgcat/pkgIndex.tcl: fails on (some) Windows 7. Bump to 1.4.5
+ * unix/Makefile.in
+ * win/Makefile.in
+
+2012-06-29 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/GetIndex.3: Reinforced the description of the requirement for
+ the tables of names to index over to be static, following posting to
+ tcl-core by Brian Griffin about a bug caused by Tktreectrl not obeying
+ this rule correctly. This does not represent a functionality change,
+ merely a clearer documentation of a long-standing constraint.
+
+2012-06-26 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tcl.m4: Let Cygwin shared build link with
+ * unix/configure.in: zlib1.dll, not cygz.dll (two less
+ * unix/configure: dependencies on cygwin-specific dll's)
+ * unix/Makefile.in:
+
+2012-06-26 Reinhard Max <max@suse.de>
+
+ * generic/tclIOSock.c: Use EAI_SYSTEM only if it exists.
+ * unix/tclUnixSock.c:
+
+2012-06-25 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclFileSystem.h: [Bug 3024359] Make sure that the
+ * generic/tclIOUtil.c: per-thread cache of the list of file systems
+ * generic/tclPathObj.c: currently registered is only updated at times
+ when no active loops are traversing it. Also reduce the amount of
+ epoch storing and checking to where it can make a difference.
+
+2012-06-25 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclCmdAH.c (EncodingDirsObjCmd): [Bug 3537605]: Do the right
+ thing when reporting errors with the number of arguments.
+
+2012-06-25 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclfileName.c: [Patch 1536227]: Cygwin network pathname
+ * tests/fileName.test: support.
+
+2012-06-23 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/tclUnixNotfy.c: [Bug 3508771]: Cygwin notifier for handling
+ win32 events.
+
+2012-06-22 Reinhard Max <max@suse.de>
+
+ * generic/tclIOSock.c: Rework the error message generation of [socket],
+ * unix/tclUnixSock.c: so that the error code of getaddrinfo is used
+ * win/tclWinSock.c: instead of errno unless it is EAI_SYSTEM.
+
+2012-06-21 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinReg.c: [Bug 3362446]: registry keys command fails
+ * tests/registry.test: with 8.5/8.6
+
2012-06-11 Don Porter <dgp@users.sourceforge.net>
- * generic/tclBasic.c: [Bug 3532959] Make sure the lifetime management
- * generic/tclProc.c: of entries in the linePBodyPtr hash table can
- * tests/proc.test: tolerate either order of teardown, interp first,
- or Proc first.
+ * generic/tclBasic.c: [Bug 3532959]: Make sure the lifetime
+ * generic/tclProc.c: management of entries in the linePBodyPtr hash
+ * tests/proc.test: table can tolerate either order of teardown,
+ interp first, or Proc first.
2012-06-08 Don Porter <dgp@users.sourceforge.net>
@@ -11,7 +76,7 @@
* unix/tclUnixPort.h: Thanks Joe English.
* unix/configure: autoconf 2.13
- * unix/tclUnixPort.h: [Bug 3530533] Centralize #include <pthread.h>
+ * unix/tclUnixPort.h: [Bug 3530533]: Centralize #include <pthread.h>
* unix/tclUnixThrd.c: in the tclUnixPort.h header so that old unix
systems that need inclusion in all compilation units are supported.
@@ -5036,8 +5101,8 @@
2010-01-21 Miguel Sofer <msofer@users.sf.net>
- * generic/tclCompile.h: NRE-enable direct eval on BC spoilage
- * generic/tclExecute.c: [Bug 2910748]
+ * generic/tclCompile.h: [Bug 2910748]: NRE-enable direct eval on BC
+ * generic/tclExecute.c: spoilage.
* tests/nre.test:
2010-01-19 Donal K. Fellows <dkf@users.sf.net>
@@ -6026,14 +6091,15 @@
2009-10-05 Andreas Kupries <andreask@activestate.com>
* library/safe.tcl (AliasGlob): Fixed conversion of catch to
- try/finally, it had an 'on ok msg' branch missing, causing a
- silent error immediately, and bogus glob results, breaking
- search for Tcl modules.
+ try/finally, it had an 'on ok msg' branch missing, causing a silent
+ error immediately, and bogus glob results, breaking search for Tcl
+ modules.
2009-10-04 Daniel Steffen <das@users.sourceforge.net>
- * macosx/tclMacOSXBundle.c: Workaround CF memory managment bug in
- * unix/tclUnixInit.c: Mac OS X 10.4 & earlier. [Bug 2569449]
+ * macosx/tclMacOSXBundle.c: [Bug 2569449]: Workaround CF memory
+ * unix/tclUnixInit.c: managment bug in Mac OS X 10.4 &
+ earlier.
2009-10-02 Kevin B. Kenny <kennykb@acm.org>
diff --git a/compat/zlib/win32/zlib1.dll b/compat/zlib/win32/zlib1.dll
index 869b00d..9943b3e 100644
--- a/compat/zlib/win32/zlib1.dll
+++ b/compat/zlib/win32/zlib1.dll
Binary files differ
diff --git a/doc/GetIndex.3 b/doc/GetIndex.3
index f60feb5..50607ae 100644
--- a/doc/GetIndex.3
+++ b/doc/GetIndex.3
@@ -32,10 +32,16 @@ table entry.
.AP "const char *const" *tablePtr in
An array of null-terminated strings. The end of the array is marked
by a NULL string pointer.
+Note that references to the \fItablePtr\fR may be retained in the
+internal representation of \fIobjPtr\fR, so this should represent the
+address of a statically-allocated array.
.AP "const void" *structTablePtr in
An array of arbitrary type, typically some \fBstruct\fR type.
The first member of the structure must be a null-terminated string.
The size of the structure is given by \fIoffset\fR.
+Note that references to the \fIstructTablePtr\fR may be retained in the
+internal representation of \fIobjPtr\fR, so this should represent the
+address of a statically-allocated array of structures.
.AP int offset in
The offset to add to structTablePtr to get to the next entry.
The end of the array is marked by a NULL string pointer.
@@ -51,10 +57,10 @@ The index of the string in \fItablePtr\fR that matches the value of
.BE
.SH DESCRIPTION
.PP
-This procedure provides an efficient way for looking up keywords,
+These procedures provide an efficient way for looking up keywords,
switch names, option names, and similar things where the value of
an object must be one of a predefined set of values.
-\fIObjPtr\fR is compared against each of
+\fBTcl_GetIndexFromObj\fR compares \fIobjPtr\fR against each of
the strings in \fItablePtr\fR to find a match. A match occurs if
\fIobjPtr\fR's string value is identical to one of the strings in
\fItablePtr\fR, or if it is a non-empty unique abbreviation
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 4292224..6dfc705 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -629,24 +629,26 @@ EncodingDirsObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
+ Tcl_Obj *dirListObj;
+
if (objc > 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "?dirList?");
+ Tcl_WrongNumArgs(interp, 2, objv, "?dirList?");
return TCL_ERROR;
}
- objc -= 1;
- objv += 1;
- if (objc == 1) {
+ if (objc == 2) {
Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
return TCL_OK;
}
- if (Tcl_SetEncodingSearchPath(objv[1]) == TCL_ERROR) {
+
+ dirListObj = objv[2];
+ if (Tcl_SetEncodingSearchPath(dirListObj) == TCL_ERROR) {
Tcl_AppendResult(interp, "expected directory list but got \"",
- TclGetString(objv[1]), "\"", NULL);
+ TclGetString(dirListObj), "\"", NULL);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "ENCODING", "BADPATH",
NULL);
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, objv[1]);
+ Tcl_SetObjResult(interp, dirListObj);
return TCL_OK;
}
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index e45ae6a..b5ae6ea 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -772,9 +772,9 @@ TclCygwinPutenv(
} else {
int size;
- size = cygwin_posix_to_win32_path_list_buf_size(value);
+ size = cygwin_conv_path_list(0, value, NULL, 0);
buf = alloca(size + 1);
- cygwin_posix_to_win32_path_list(value, buf);
+ cygwin_conv_path_list(0, value, buf, size);
}
SetEnvironmentVariableA(name, buf);
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index b130169..48c5454 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -424,9 +424,17 @@ TclpGetNativePathType(
}
#endif
if (path[0] == '/') {
+#ifdef __CYGWIN__
+ /*
+ * Check for Cygwin // network path prefix
+ */
+ if (path[1] == '/') {
+ path++;
+ }
+#endif
if (driveNameLengthPtr != NULL) {
/*
- * We need this addition in case the QNX code was used.
+ * We need this addition in case the QNX or Cygwin code was used.
*/
*driveNameLengthPtr = (1 + path - origPath);
@@ -653,11 +661,20 @@ SplitUnixPath(
}
#endif
- if (path[0] == '/') {
- Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj("/",1));
- p = path+1;
- } else {
- p = path;
+ p = path;
+ if (*p == '/') {
+ Tcl_Obj *rootElt = Tcl_NewStringObj("/", 1);
+ p++;
+#ifdef __CYGWIN__
+ /*
+ * Check for Cygwin // network path prefix
+ */
+ if (*p == '/') {
+ Tcl_AppendToObj(rootElt, "/", 1);
+ p++;
+ }
+#endif
+ Tcl_ListObjAppendElement(NULL, result, rootElt);
}
/*
@@ -2400,17 +2417,6 @@ DoGlob(
Tcl_DStringAppend(&append, ".", 1);
}
}
-#if defined(__CYGWIN__) && !defined(__WIN32__)
- {
- DLLIMPORT extern int cygwin_conv_to_posix_path(const char *,
- char *);
- char winbuf[MAXPATHLEN+1];
-
- cygwin_conv_to_posix_path(Tcl_DStringValue(&append), winbuf);
- Tcl_DStringFree(&append);
- Tcl_DStringAppend(&append, winbuf, -1);
- }
-#endif /* __CYGWIN__ && __WIN32__ */
break;
}
diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h
index 5e48dec..6be3e03 100644
--- a/generic/tclFileSystem.h
+++ b/generic/tclFileSystem.h
@@ -16,45 +16,6 @@
#include "tcl.h"
/*
- * struct FilesystemRecord --
- *
- * A filesystem record is used to keep track of each filesystem currently
- * registered with the core, in a linked list. Pointers to these structures
- * are also kept by each "path" Tcl_Obj, and we must retain a refCount on the
- * number of such references.
- */
-
-typedef struct FilesystemRecord {
- ClientData clientData; /* Client specific data for the new filesystem
- * (can be NULL) */
- const Tcl_Filesystem *fsPtr; /* Pointer to filesystem dispatch table. */
- int fileRefCount; /* How many Tcl_Obj's use this filesystem. */
- struct FilesystemRecord *nextPtr;
- /* The next filesystem registered to Tcl, or
- * NULL if no more. */
- struct FilesystemRecord *prevPtr;
- /* The previous filesystem registered to Tcl,
- * or NULL if no more. */
-} FilesystemRecord;
-
-/*
- * This structure holds per-thread private copy of the current directory
- * maintained by the global cwdPathPtr. This structure holds per-thread
- * private copies of some global data. This way we avoid most of the
- * synchronization calls which boosts performance, at cost of having to update
- * this information each time the corresponding epoch counter changes.
- */
-
-typedef struct ThreadSpecificData {
- int initialized;
- int cwdPathEpoch;
- int filesystemEpoch;
- Tcl_Obj *cwdPathPtr;
- ClientData cwdClientData;
- FilesystemRecord *filesystemList;
-} ThreadSpecificData;
-
-/*
* The internal TclFS API provides routines for handling and manipulating
* paths efficiently, taking direct advantage of the "path" Tcl_Obj type.
*
@@ -62,31 +23,23 @@ typedef struct ThreadSpecificData {
*/
MODULE_SCOPE int TclFSCwdPointerEquals(Tcl_Obj **pathPtrPtr);
-MODULE_SCOPE int TclFSMakePathFromNormalized(Tcl_Interp *interp,
- Tcl_Obj *pathPtr, ClientData clientData);
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(
- const Tcl_Filesystem *fromFilesystem,
- ClientData clientData,
- FilesystemRecord **fsRecPtrPtr);
MODULE_SCOPE int TclFSEnsureEpochOk(Tcl_Obj *pathPtr,
const Tcl_Filesystem **fsPtrPtr);
MODULE_SCOPE void TclFSSetPathDetails(Tcl_Obj *pathPtr,
- FilesystemRecord *fsRecPtr,
- ClientData clientData);
+ const Tcl_Filesystem *fsPtr, ClientData clientData);
MODULE_SCOPE Tcl_Obj * TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
- Tcl_Obj *pathPtr, ClientData *clientDataPtr);
+ Tcl_Obj *pathPtr);
+MODULE_SCOPE int TclFSEpoch(void);
/*
* Private shared variables for use by tclIOUtil.c and tclPathObj.c
*/
MODULE_SCOPE const Tcl_Filesystem tclNativeFilesystem;
-MODULE_SCOPE Tcl_ThreadDataKey tclFsDataKey;
/*
* Private shared functions for use by tclIOUtil.c, tclPathObj.c and
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 89d6c02..018f9f5 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -100,16 +100,16 @@ TclSockMinimumBuffers(
socklen_t len;
len = sizeof(int);
- getsockopt((SOCKET)sock, SOL_SOCKET, SO_SNDBUF, (char *)&current, &len);
+ getsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_SNDBUF, (char *)&current, &len);
if (current < size) {
len = sizeof(int);
- setsockopt((SOCKET)sock, SOL_SOCKET, SO_SNDBUF, (char *)&size, len);
+ setsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_SNDBUF, (char *)&size, len);
}
len = sizeof(int);
- getsockopt((SOCKET)sock, SOL_SOCKET, SO_RCVBUF, (char *)&current, &len);
+ getsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_RCVBUF, (char *)&current, &len);
if (current < size) {
len = sizeof(int);
- setsockopt((SOCKET)sock, SOL_SOCKET, SO_RCVBUF, (char *)&size, len);
+ setsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_RCVBUF, (char *)&size, len);
}
return TCL_OK;
}
@@ -206,7 +206,13 @@ TclCreateSocketAddress(
}
if (result != 0) {
- goto error;
+#ifdef EAI_SYSTEM /* Doesn't exist on Windows */
+ if (result == EAI_SYSTEM)
+ *errorMsgPtr = Tcl_PosixError(interp);
+ else
+#endif
+ *errorMsgPtr = gai_strerror(result);
+ return 0;
}
/*
@@ -249,33 +255,6 @@ TclCreateSocketAddress(
}
return 1;
-
- /*
- * Ought to use gai_strerror() here...
- */
-
-error:
- switch (result) {
- case EAI_NONAME:
- case EAI_SERVICE:
-#if defined(EAI_ADDRFAMILY) && EAI_ADDRFAMILY != EAI_NONAME
- case EAI_ADDRFAMILY:
-#endif
-#if defined(EAI_NODATA) && EAI_NODATA != EAI_NONAME
- case EAI_NODATA:
-#endif
- *errorMsgPtr = gai_strerror(result);
- errno = EHOSTUNREACH;
- return 0;
-#ifdef EAI_SYSTEM
- case EAI_SYSTEM:
- return 0;
-#endif
- default:
- *errorMsgPtr = gai_strerror(result);
- errno = ENXIO;
- return 0;
- }
}
/*
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index c4e7db0..bea1897 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -28,6 +28,43 @@
#include "tclFileSystem.h"
/*
+ * struct FilesystemRecord --
+ *
+ * A filesystem record is used to keep track of each filesystem currently
+ * registered with the core, in a linked list.
+ */
+
+typedef struct FilesystemRecord {
+ ClientData clientData; /* Client specific data for the new filesystem
+ * (can be NULL) */
+ const Tcl_Filesystem *fsPtr;/* Pointer to filesystem dispatch table. */
+ struct FilesystemRecord *nextPtr;
+ /* The next filesystem registered to Tcl, or
+ * NULL if no more. */
+ struct FilesystemRecord *prevPtr;
+ /* The previous filesystem registered to Tcl,
+ * or NULL if no more. */
+} FilesystemRecord;
+
+/*
+ * This structure holds per-thread private copy of the current directory
+ * maintained by the global cwdPathPtr. This structure holds per-thread
+ * private copies of some global data. This way we avoid most of the
+ * synchronization calls which boosts performance, at cost of having to update
+ * this information each time the corresponding epoch counter changes.
+ */
+
+typedef struct ThreadSpecificData {
+ int initialized;
+ int cwdPathEpoch;
+ int filesystemEpoch;
+ Tcl_Obj *cwdPathPtr;
+ ClientData cwdClientData;
+ FilesystemRecord *filesystemList;
+ int claims;
+} ThreadSpecificData;
+
+/*
* Prototypes for functions defined later in this file.
*/
@@ -40,9 +77,10 @@ static void FsAddMountsToGlobResult(Tcl_Obj *resultPtr,
Tcl_Obj *pathPtr, const char *pattern,
Tcl_GlobTypeData *types);
static void FsUpdateCwd(Tcl_Obj *cwdObj, ClientData clientData);
-#ifdef TCL_THREADS
static void FsRecacheFilesystemList(void);
-#endif
+static void Claim(void);
+static void Disclaim(void);
+
static void * DivertFindSymbol(Tcl_Interp *interp,
Tcl_LoadHandle loadHandle, const char *symbol);
static void DivertUnloadFile(Tcl_LoadHandle loadHandle);
@@ -163,7 +201,6 @@ const Tcl_Filesystem tclNativeFilesystem = {
static FilesystemRecord nativeFilesystemRecord = {
NULL,
&tclNativeFilesystem,
- 1,
NULL,
NULL
};
@@ -175,7 +212,7 @@ static FilesystemRecord nativeFilesystemRecord = {
* trigger cache cleanup in all threads.
*/
-static int theFilesystemEpoch = 0;
+static int theFilesystemEpoch = 1;
/*
* Stores the linked list of filesystems. A 1:1 copy of this list is also
@@ -195,7 +232,7 @@ static int cwdPathEpoch = 0;
static ClientData cwdClientData = NULL;
TCL_DECLARE_MUTEX(cwdMutex)
-Tcl_ThreadDataKey tclFsDataKey;
+static Tcl_ThreadDataKey fsDataKey;
/*
* One of these structures is used each time we successfully load a file from
@@ -419,9 +456,8 @@ FsThrExitProc(
fsRecPtr = tsdPtr->filesystemList;
while (fsRecPtr != NULL) {
tmpFsRecPtr = fsRecPtr->nextPtr;
- if (--fsRecPtr->fileRefCount <= 0) {
- ckfree(fsRecPtr);
- }
+ fsRecPtr->fsPtr = NULL;
+ ckfree(fsRecPtr);
fsRecPtr = tmpFsRecPtr;
}
tsdPtr->initialized = 0;
@@ -430,7 +466,7 @@ FsThrExitProc(
int
TclFSCwdIsNative(void)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
if (tsdPtr->cwdClientData != NULL) {
return 1;
@@ -464,7 +500,7 @@ int
TclFSCwdPointerEquals(
Tcl_Obj **pathPtrPtr)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
Tcl_MutexLock(&cwdMutex);
if (tsdPtr->cwdPathPtr == NULL
@@ -523,12 +559,11 @@ TclFSCwdPointerEquals(
}
}
-#ifdef TCL_THREADS
static void
FsRecacheFilesystemList(void)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
- FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+ FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL, *toFree = NULL, *list;
/*
* Trash the current cache.
@@ -537,20 +572,16 @@ FsRecacheFilesystemList(void)
fsRecPtr = tsdPtr->filesystemList;
while (fsRecPtr != NULL) {
tmpFsRecPtr = fsRecPtr->nextPtr;
- if (--fsRecPtr->fileRefCount <= 0) {
- ckfree(fsRecPtr);
- }
+ fsRecPtr->nextPtr = toFree;
+ toFree = fsRecPtr;
fsRecPtr = tmpFsRecPtr;
}
- tsdPtr->filesystemList = NULL;
/*
- * Code below operates on shared data. We are already called under mutex
- * lock so we can safely proceed.
- *
* Locate tail of the global filesystem list.
*/
+ Tcl_MutexLock(&filesystemMutex);
fsRecPtr = filesystemList;
while (fsRecPtr != NULL) {
tmpFsRecPtr = fsRecPtr;
@@ -561,18 +592,26 @@ FsRecacheFilesystemList(void)
* Refill the cache honouring the order.
*/
+ list = NULL;
fsRecPtr = tmpFsRecPtr;
while (fsRecPtr != NULL) {
tmpFsRecPtr = ckalloc(sizeof(FilesystemRecord));
*tmpFsRecPtr = *fsRecPtr;
- tmpFsRecPtr->nextPtr = tsdPtr->filesystemList;
+ tmpFsRecPtr->nextPtr = list;
tmpFsRecPtr->prevPtr = NULL;
- if (tsdPtr->filesystemList) {
- tsdPtr->filesystemList->prevPtr = tmpFsRecPtr;
- }
- tsdPtr->filesystemList = tmpFsRecPtr;
+ list = tmpFsRecPtr;
fsRecPtr = fsRecPtr->prevPtr;
}
+ tsdPtr->filesystemList = list;
+ tsdPtr->filesystemEpoch = theFilesystemEpoch;
+ Tcl_MutexUnlock(&filesystemMutex);
+
+ while (toFree) {
+ FilesystemRecord *next = toFree->nextPtr;
+ toFree->fsPtr = NULL;
+ ckfree(toFree);
+ toFree = next;
+ }
/*
* Make sure the above gets released on thread exit.
@@ -583,28 +622,16 @@ FsRecacheFilesystemList(void)
tsdPtr->initialized = 1;
}
}
-#endif /* TCL_THREADS */
static FilesystemRecord *
FsGetFirstFilesystem(void)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
- FilesystemRecord *fsRecPtr;
-
-#ifndef TCL_THREADS
- tsdPtr->filesystemEpoch = theFilesystemEpoch;
- fsRecPtr = filesystemList;
-#else
- Tcl_MutexLock(&filesystemMutex);
- if (tsdPtr->filesystemList == NULL
- || (tsdPtr->filesystemEpoch != theFilesystemEpoch)) {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+ if (tsdPtr->filesystemList == NULL || ((tsdPtr->claims == 0)
+ && (tsdPtr->filesystemEpoch != theFilesystemEpoch))) {
FsRecacheFilesystemList();
- tsdPtr->filesystemEpoch = theFilesystemEpoch;
}
- Tcl_MutexUnlock(&filesystemMutex);
- fsRecPtr = tsdPtr->filesystemList;
-#endif
- return fsRecPtr;
+ return tsdPtr->filesystemList;
}
/*
@@ -616,11 +643,30 @@ int
TclFSEpochOk(
int filesystemEpoch)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ return (filesystemEpoch == 0 || filesystemEpoch == theFilesystemEpoch);
+}
+
+static void
+Claim()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+ tsdPtr->claims++;
+}
+
+static void
+Disclaim()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+ tsdPtr->claims--;
+}
- (void) FsGetFirstFilesystem();
- return (filesystemEpoch == tsdPtr->filesystemEpoch);
+int
+TclFSEpoch()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
+ return tsdPtr->filesystemEpoch;
}
+
/*
* If non-NULL, clientData is owned by us and must be freed later.
@@ -633,7 +679,7 @@ FsUpdateCwd(
{
int len;
const char *str = NULL;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
if (cwdObj != NULL) {
str = Tcl_GetStringFromObj(cwdObj, &len);
@@ -730,17 +776,14 @@ TclFinalizeFilesystem(void)
while (fsRecPtr != NULL) {
FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr;
- if (fsRecPtr->fileRefCount <= 0) {
- /*
- * The native filesystem is static, so we don't free it.
- */
+ /* The native filesystem is static, so we don't free it. */
- if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
- ckfree(fsRecPtr);
- }
+ if (fsRecPtr != &nativeFilesystemRecord) {
+ ckfree(fsRecPtr);
}
fsRecPtr = tmpFsRecPtr;
}
+ theFilesystemEpoch++;
filesystemList = NULL;
/*
@@ -773,11 +816,7 @@ void
TclResetFilesystem(void)
{
filesystemList = &nativeFilesystemRecord;
-
- /*
- * Note, at this point, I believe nativeFilesystemRecord -> fileRefCount
- * should equal 1 and if not, we should try to track down the cause.
- */
+ theFilesystemEpoch++;
#ifdef __WIN32__
/*
@@ -836,13 +875,6 @@ Tcl_FSRegister(
newFilesystemPtr->fsPtr = fsPtr;
/*
- * We start with a refCount of 1. If this drops to zero, then anyone is
- * welcome to ckfree us.
- */
-
- newFilesystemPtr->fileRefCount = 1;
-
- /*
* Is this lock and wait strictly speaking necessary? Since any iterators
* out there will have grabbed a copy of the head of the list and be
* iterating away from that, if we add a new element to the head of the
@@ -915,7 +947,7 @@ Tcl_FSUnregister(
*/
fsRecPtr = filesystemList;
- while ((retVal == TCL_ERROR) && (fsRecPtr->fsPtr != &tclNativeFilesystem)) {
+ while ((retVal == TCL_ERROR) && (fsRecPtr != &nativeFilesystemRecord)) {
if (fsRecPtr->fsPtr == fsPtr) {
if (fsRecPtr->prevPtr) {
fsRecPtr->prevPtr->nextPtr = fsRecPtr->nextPtr;
@@ -936,10 +968,7 @@ Tcl_FSUnregister(
theFilesystemEpoch++;
- fsRecPtr->fileRefCount--;
- if (fsRecPtr->fileRefCount <= 0) {
- ckfree(fsRecPtr);
- }
+ ckfree(fsRecPtr);
retVal = TCL_OK;
} else {
@@ -1347,14 +1376,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
@@ -1365,6 +1389,7 @@ TclFSNormalizeToUniquePath(
firstFsRecPtr = FsGetFirstFilesystem();
+ Claim();
for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
continue;
@@ -1402,6 +1427,7 @@ TclFSNormalizeToUniquePath(
* but there's not much benefit.
*/
}
+ Disclaim();
return startAt;
}
@@ -2596,7 +2622,7 @@ Tcl_Obj *
Tcl_FSGetCwd(
Tcl_Interp *interp)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
if (TclFSCwdPointerEquals(NULL)) {
FilesystemRecord *fsRecPtr;
@@ -2608,8 +2634,9 @@ Tcl_FSGetCwd(
* indicates the particular function has succeeded.
*/
- for (fsRecPtr = FsGetFirstFilesystem();
- (retVal == NULL) && (fsRecPtr != NULL);
+ fsRecPtr = FsGetFirstFilesystem();
+ Claim();
+ for (; (retVal == NULL) && (fsRecPtr != NULL);
fsRecPtr = fsRecPtr->nextPtr) {
ClientData retCd;
TclFSGetCwdProc2 *proc2;
@@ -2633,7 +2660,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 storage. We
@@ -2654,6 +2681,7 @@ Tcl_FSGetCwd(
}
Tcl_DecrRefCount(retVal);
retVal = NULL;
+ Disclaim();
goto cdDidNotChange;
} else if (interp != NULL) {
Tcl_AppendResult(interp,
@@ -2661,6 +2689,7 @@ Tcl_FSGetCwd(
Tcl_PosixError(interp), NULL);
}
}
+ Disclaim();
/*
* Now the 'cwd' may NOT be normalized, at least on some platforms.
@@ -2672,7 +2701,7 @@ Tcl_FSGetCwd(
*/
if (retVal != NULL) {
- Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);
+ Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal);
if (norm != NULL) {
/*
@@ -2762,7 +2791,7 @@ Tcl_FSGetCwd(
* Normalize the path.
*/
- norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);
+ norm = TclFSNormalizeAbsolutePath(interp, retVal);
/*
* Check whether cwd has changed from the value previously stored in
@@ -2944,7 +2973,7 @@ Tcl_FSChdir(
* instead. This should be examined by someone on Unix.
*/
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
ClientData cd;
ClientData oldcd = tsdPtr->cwdClientData;
@@ -3781,6 +3810,7 @@ Tcl_FSListVolumes(void)
*/
fsRecPtr = FsGetFirstFilesystem();
+ Claim();
while (fsRecPtr != NULL) {
if (fsRecPtr->fsPtr->listVolumesProc != NULL) {
Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
@@ -3792,6 +3822,7 @@ Tcl_FSListVolumes(void)
}
fsRecPtr = fsRecPtr->nextPtr;
}
+ Disclaim();
return resultPtr;
}
@@ -3831,6 +3862,7 @@ FsListMounts(
*/
fsRecPtr = FsGetFirstFilesystem();
+ Claim();
while (fsRecPtr != NULL) {
if (fsRecPtr->fsPtr != &tclNativeFilesystem &&
fsRecPtr->fsPtr->matchInDirectoryProc != NULL) {
@@ -3842,6 +3874,7 @@ FsListMounts(
}
fsRecPtr = fsRecPtr->nextPtr;
}
+ Disclaim();
return resultPtr;
}
@@ -3953,31 +3986,6 @@ Tcl_FSSplitPath(
}
return result;
}
-
-/* Simple helper function. */
-Tcl_Obj *
-TclFSInternalToNormalized(
- const Tcl_Filesystem *fromFilesystem,
- ClientData clientData,
- FilesystemRecord **fsRecPtrPtr)
-{
- FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();
-
- while (fsRecPtr != NULL) {
- if (fsRecPtr->fsPtr == fromFilesystem) {
- *fsRecPtrPtr = fsRecPtr;
- break;
- }
- fsRecPtr = fsRecPtr->nextPtr;
- }
-
- if ((fsRecPtr == NULL)
- || (fromFilesystem->internalToNormalizedProc == NULL)) {
- return NULL;
- }
- return fromFilesystem->internalToNormalizedProc(clientData);
-}
-
/*
*----------------------------------------------------------------------
*
@@ -4079,6 +4087,7 @@ TclFSNonnativePathType(
*/
fsRecPtr = FsGetFirstFilesystem();
+ Claim();
while (fsRecPtr != NULL) {
/*
* We want to skip the native filesystem in this loop because
@@ -4156,6 +4165,7 @@ TclFSNonnativePathType(
}
fsRecPtr = fsRecPtr->nextPtr;
}
+ Disclaim();
return type;
}
@@ -4543,10 +4553,14 @@ Tcl_FSGetFileSystemForPath(
*/
fsRecPtr = FsGetFirstFilesystem();
+ Claim();
+
if (TclFSEnsureEpochOk(pathPtr, &retVal) != TCL_OK) {
+ Disclaim();
return NULL;
} else if (retVal != NULL) {
/* TODO: Can this happen? */
+ Disclaim();
return retVal;
}
@@ -4568,10 +4582,12 @@ Tcl_FSGetFileSystemForPath(
* call to the pathInFilesystemProc.
*/
- TclFSSetPathDetails(pathPtr, fsRecPtr, clientData);
+ TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData);
+ Disclaim();
return fsRecPtr->fsPtr;
}
}
+ Disclaim();
return NULL;
}
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 97517ea..9f73a31 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -1095,6 +1095,11 @@ declare 16 win {
# declare 17 win {
# char *TclpGetTZName(void)
# }
+# new for 8.5.12+ Cygwin only
+declare 17 win {
+ int TclUnixCopyFile(const char *src, const char *dst,
+ const Tcl_StatBuf *statBufPtr, int dontCopyAtts)
+}
declare 18 win {
TclFile TclpMakeFile(Tcl_Channel channel, int direction)
}
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index a9c6e8c..7322a37 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -140,7 +140,10 @@ EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc,
Tcl_Pid *pidPtr);
/* 16 */
EXTERN int TclpIsAtty(int fd);
-/* Slot 17 is reserved */
+/* 17 */
+EXTERN int TclUnixCopyFile(const char *src, const char *dst,
+ const Tcl_StatBuf *statBufPtr,
+ int dontCopyAtts);
/* 18 */
EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
/* 19 */
@@ -289,7 +292,7 @@ typedef struct TclIntPlatStubs {
int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
int (*tclpIsAtty) (int fd); /* 16 */
- void (*reserved17)(void);
+ int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
@@ -433,7 +436,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
#define TclpIsAtty \
(tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
-/* Slot 17 is reserved */
+#define TclUnixCopyFile \
+ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
#define TclpMakeFile \
(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
#define TclpOpenFile \
diff --git a/generic/tclPanic.c b/generic/tclPanic.c
index 84a9136..b87a8df 100644
--- a/generic/tclPanic.c
+++ b/generic/tclPanic.c
@@ -102,24 +102,23 @@ Tcl_PanicVA(
arg8);
fprintf(stderr, "\n");
fflush(stderr);
- }
- /* In case the users panic proc does not abort, we do it here */
#if defined(_WIN32) || defined(__CYGWIN__)
# if defined(__GNUC__)
- __builtin_trap();
+ __builtin_trap();
# elif defined(_WIN64)
- __debugbreak();
+ __debugbreak();
# elif defined(_MSC_VER)
- _asm {int 3}
+ _asm {int 3}
# else
- DebugBreak();
+ DebugBreak();
# endif
#endif
#if defined(_WIN32)
- ExitProcess(1);
+ ExitProcess(1);
#else
- abort();
+ abort();
#endif
+ }
}
/*
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 2402128..8bae4fb 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -27,6 +27,8 @@ static int SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static int FindSplitPos(const char *path, int separator);
static int IsSeparatorOrNull(int ch);
static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr);
+static int MakePathFromNormalized(Tcl_Interp *interp,
+ Tcl_Obj *pathPtr);
/*
* Define the 'path' object type, which Tcl uses to represent file paths
@@ -92,9 +94,7 @@ typedef struct FsPath {
* generated during the correct filesystem
* epoch. The epoch changes when
* filesystem-mounts are changed. */
- struct FilesystemRecord *fsRecPtr;
- /* Pointer to the filesystem record entry to
- * use for this path. */
+ const Tcl_Filesystem *fsPtr;/* The Tcl_Filesystem that claims this path */
} FsPath;
/*
@@ -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
@@ -433,17 +427,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;
- }
+ MakePathFromNormalized(interp, retVal);
/*
* This has a refCount of 1 for the caller, unlike many Tcl_Obj APIs.
@@ -575,8 +566,7 @@ TclPathPart(
if (pathPtr->typePtr == &tclFsPathType) {
FsPath *fsPathPtr = PATHOBJ(pathPtr);
- if (TclFSEpochOk(fsPathPtr->filesystemEpoch)
- && (PATHFLAGS(pathPtr) != 0)) {
+ if (PATHFLAGS(pathPtr) != 0) {
switch (portion) {
case TCL_PATH_DIRNAME: {
/*
@@ -1274,7 +1264,6 @@ TclNewFSPathObj(
{
FsPath *fsPathPtr;
Tcl_Obj *pathPtr;
- ThreadSpecificData *tsdPtr;
const char *p;
int state = 0, count = 0;
@@ -1302,8 +1291,6 @@ TclNewFSPathObj(
return pathPtr;
}
- tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
-
pathPtr = Tcl_NewObj();
fsPathPtr = ckalloc(sizeof(FsPath));
@@ -1317,8 +1304,8 @@ TclNewFSPathObj(
fsPathPtr->cwdPtr = dirPtr;
Tcl_IncrRefCount(dirPtr);
fsPathPtr->nativePathPtr = NULL;
- fsPathPtr->fsRecPtr = NULL;
- fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
+ fsPathPtr->fsPtr = NULL;
+ fsPathPtr->filesystemEpoch = 0;
SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = TCLPATH_APPENDED;
@@ -1428,8 +1415,7 @@ TclFSMakePathRelative(
if (pathPtr->typePtr == &tclFsPathType) {
FsPath *fsPathPtr = PATHOBJ(pathPtr);
- if (PATHFLAGS(pathPtr) != 0
- && fsPathPtr->cwdPtr == cwdPtr) {
+ if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) {
return fsPathPtr->normPathPtr;
}
}
@@ -1473,7 +1459,7 @@ TclFSMakePathRelative(
/*
*---------------------------------------------------------------------------
*
- * TclFSMakePathFromNormalized --
+ * MakePathFromNormalized --
*
* Like SetFsPathFromAny, but assumes the given object is an absolute
* normalized path. Only for internal use.
@@ -1487,15 +1473,12 @@ TclFSMakePathRelative(
*---------------------------------------------------------------------------
*/
-int
-TclFSMakePathFromNormalized(
+static int
+MakePathFromNormalized(
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);
if (pathPtr->typePtr == &tclFsPathType) {
return TCL_OK;
@@ -1536,9 +1519,10 @@ TclFSMakePathFromNormalized(
fsPathPtr->normPathPtr = pathPtr;
fsPathPtr->cwdPtr = NULL;
- fsPathPtr->nativePathPtr = nativeRep;
- fsPathPtr->fsRecPtr = NULL;
- fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
+ fsPathPtr->nativePathPtr = NULL;
+ fsPathPtr->fsPtr = NULL;
+ /* Remember the epoch under which we decided pathPtr was normalized */
+ fsPathPtr->filesystemEpoch = TclFSEpoch();
SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = 0;
@@ -1577,14 +1561,13 @@ Tcl_FSNewNativePath(
const Tcl_Filesystem *fromFilesystem,
ClientData clientData)
{
- Tcl_Obj *pathPtr;
+ Tcl_Obj *pathPtr = NULL;
FsPath *fsPathPtr;
- FilesystemRecord *fsFromPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
- pathPtr = TclFSInternalToNormalized(fromFilesystem, clientData,
- &fsFromPtr);
+ if (fromFilesystem->internalToNormalizedProc != NULL) {
+ pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData);
+ }
if (pathPtr == NULL) {
return NULL;
}
@@ -1615,9 +1598,8 @@ Tcl_FSNewNativePath(
fsPathPtr->normPathPtr = pathPtr;
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = clientData;
- fsPathPtr->fsRecPtr = fsFromPtr;
- fsPathPtr->fsRecPtr->fileRefCount++;
- fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
+ fsPathPtr->fsPtr = fromFilesystem;
+ fsPathPtr->filesystemEpoch = TclFSEpoch();
SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = 0;
@@ -1675,6 +1657,12 @@ Tcl_FSGetTranslatedPath(
retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1,
&srcFsPathPtr->normPathPtr);
srcFsPathPtr->translatedPathPtr = retObj;
+ if (translatedCwdPtr->typePtr == &tclFsPathType) {
+ srcFsPathPtr->filesystemEpoch
+ = PATHOBJ(translatedCwdPtr)->filesystemEpoch;
+ } else {
+ srcFsPathPtr->filesystemEpoch = 0;
+ }
Tcl_IncrRefCount(retObj);
Tcl_DecrRefCount(translatedCwdPtr);
} else {
@@ -1778,7 +1766,6 @@ Tcl_FSGetNormalizedPath(
Tcl_Obj *dir, *copy;
int cwdLen, pathType;
- ClientData clientData = NULL;
pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr);
@@ -1811,7 +1798,7 @@ Tcl_FSGetNormalizedPath(
* 2385549] ...
*/
- Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy, NULL);
+ Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy);
Tcl_DecrRefCount(copy);
copy = newCopy;
@@ -1826,8 +1813,7 @@ Tcl_FSGetNormalizedPath(
* will actually start off directly 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. */
@@ -1870,15 +1856,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;
}
@@ -1899,7 +1876,6 @@ Tcl_FSGetNormalizedPath(
} else if (fsPathPtr->normPathPtr == NULL) {
int cwdLen;
Tcl_Obj *copy;
- ClientData clientData = NULL;
copy = AppendPath(fsPathPtr->cwdPtr, pathPtr);
@@ -1911,17 +1887,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;
@@ -2003,12 +1974,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
@@ -2099,7 +2065,7 @@ Tcl_FSGetInternalRep(
* not easily achievable with the current implementation.
*/
- if (srcFsPathPtr->fsRecPtr == NULL) {
+ if (srcFsPathPtr->fsPtr == NULL) {
/*
* This only usually happens in wrappers like TclpStat which create a
* string object and pass it to TclpObjStat. Code which calls the
@@ -2119,7 +2085,7 @@ Tcl_FSGetInternalRep(
*/
srcFsPathPtr = PATHOBJ(pathPtr);
- if (srcFsPathPtr->fsRecPtr == NULL) {
+ if (srcFsPathPtr->fsPtr == NULL) {
return NULL;
}
}
@@ -2131,7 +2097,7 @@ Tcl_FSGetInternalRep(
* for this is we ask what filesystem this path belongs to.
*/
- if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) {
+ if (fsPtr != srcFsPathPtr->fsPtr) {
const Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathPtr);
if (actualFs == fsPtr) {
@@ -2144,7 +2110,7 @@ Tcl_FSGetInternalRep(
Tcl_FSCreateInternalRepProc *proc;
char *nativePathPtr;
- proc = srcFsPathPtr->fsRecPtr->fsPtr->createInternalRepProc;
+ proc = srcFsPathPtr->fsPtr->createInternalRepProc;
if (proc == NULL) {
return NULL;
}
@@ -2212,8 +2178,8 @@ TclFSEnsureEpochOk(
* Check whether the object is already assigned to a fs.
*/
- if (srcFsPathPtr->fsRecPtr != NULL) {
- *fsPtrPtr = srcFsPathPtr->fsRecPtr->fsPtr;
+ if (srcFsPathPtr->fsPtr != NULL) {
+ *fsPtrPtr = srcFsPathPtr->fsPtr;
}
return TCL_OK;
}
@@ -2237,10 +2203,9 @@ TclFSEnsureEpochOk(
void
TclFSSetPathDetails(
Tcl_Obj *pathPtr,
- FilesystemRecord *fsRecPtr,
+ const Tcl_Filesystem *fsPtr,
ClientData clientData)
{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
FsPath *srcFsPathPtr;
/*
@@ -2254,10 +2219,9 @@ TclFSSetPathDetails(
}
srcFsPathPtr = PATHOBJ(pathPtr);
- srcFsPathPtr->fsRecPtr = fsRecPtr;
+ srcFsPathPtr->fsPtr = fsPtr;
srcFsPathPtr->nativePathPtr = clientData;
- srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
- fsRecPtr->fileRefCount++;
+ srcFsPathPtr->filesystemEpoch = TclFSEpoch();
}
/*
@@ -2346,7 +2310,6 @@ SetFsPathFromAny(
FsPath *fsPathPtr;
Tcl_Obj *transPtr;
char *name;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
if (pathPtr->typePtr == &tclFsPathType) {
return TCL_OK;
@@ -2500,12 +2463,15 @@ SetFsPathFromAny(
fsPathPtr->translatedPathPtr = transPtr;
if (transPtr != pathPtr) {
Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
+ /* Redo translation when $env(HOME) changes */
+ fsPathPtr->filesystemEpoch = TclFSEpoch();
+ } else {
+ fsPathPtr->filesystemEpoch = 0;
}
fsPathPtr->normPathPtr = NULL;
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = NULL;
- fsPathPtr->fsRecPtr = NULL;
- fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
+ fsPathPtr->fsPtr = NULL;
/*
* Free old representation before installing our new one.
@@ -2538,25 +2504,15 @@ FreeFsPathInternalRep(
if (fsPathPtr->cwdPtr != NULL) {
TclDecrRefCount(fsPathPtr->cwdPtr);
}
- if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsRecPtr != NULL) {
+ if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsPtr != NULL) {
Tcl_FSFreeInternalRepProc *freeProc =
- fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc;
+ fsPathPtr->fsPtr->freeInternalRepProc;
if (freeProc != NULL) {
freeProc(fsPathPtr->nativePathPtr);
fsPathPtr->nativePathPtr = NULL;
}
}
- if (fsPathPtr->fsRecPtr != NULL) {
- fsPathPtr->fsRecPtr->fileRefCount--;
- if (fsPathPtr->fsRecPtr->fileRefCount <= 0) {
- /*
- * It has been unregistered already.
- */
-
- ckfree(fsPathPtr->fsRecPtr);
- }
- }
ckfree(fsPathPtr);
pathPtr->typePtr = NULL;
@@ -2599,10 +2555,10 @@ DupFsPathInternalRep(
copyFsPathPtr->flags = srcFsPathPtr->flags;
- if (srcFsPathPtr->fsRecPtr != NULL
+ if (srcFsPathPtr->fsPtr != NULL
&& srcFsPathPtr->nativePathPtr != NULL) {
Tcl_FSDupInternalRepProc *dupProc =
- srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc;
+ srcFsPathPtr->fsPtr->dupInternalRepProc;
if (dupProc != NULL) {
copyFsPathPtr->nativePathPtr =
@@ -2613,11 +2569,8 @@ DupFsPathInternalRep(
} else {
copyFsPathPtr->nativePathPtr = NULL;
}
- copyFsPathPtr->fsRecPtr = srcFsPathPtr->fsRecPtr;
+ copyFsPathPtr->fsPtr = srcFsPathPtr->fsPtr;
copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch;
- if (copyFsPathPtr->fsRecPtr != NULL) {
- copyFsPathPtr->fsRecPtr->fileRefCount++;
- }
copyPtr->typePtr = &tclFsPathType;
}
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index e7febe4..87cd4eb 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -55,6 +55,7 @@ static int TclSockMinimumBuffersOld(int sock, int size)
#ifdef __WIN32__
# define TclUnixWaitForFile 0
+# define TclUnixCopyFile 0
# define TclpReaddir 0
# define TclpIsAtty 0
#elif defined(__CYGWIN__)
@@ -498,7 +499,7 @@ static const TclIntPlatStubs tclIntPlatStubs = {
TclpCreatePipe, /* 14 */
TclpCreateProcess, /* 15 */
TclpIsAtty, /* 16 */
- 0, /* 17 */
+ TclUnixCopyFile, /* 17 */
TclpMakeFile, /* 18 */
TclpOpenFile, /* 19 */
TclWinAddProcess, /* 20 */
diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl
index 5b4eae9..fef4f24 100644
--- a/library/dde/pkgIndex.tcl
+++ b/library/dde/pkgIndex.tcl
@@ -1,5 +1,5 @@
if {![package vsatisfies [package provide Tcl] 8.5]} return
-if {[string compare [info sharedlibextension] .dll]} return
+if {[info sharedlibextension] ne ".dll"} return
if {[::tcl::pkgconfig get debug]} {
package ifneeded dde 1.4.0 [list load [file join $dir tcldde14g.dll] dde]
} else {
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index 369ed52..f6c62a3 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -13,7 +13,7 @@
package require Tcl 8.5
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the installation directory in the Makefiles.
-package provide msgcat 1.4.4
+package provide msgcat 1.4.5
namespace eval msgcat {
namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \
@@ -32,7 +32,7 @@ namespace eval msgcat {
variable Msgs [dict create]
# Map of language codes used in Windows registry to those of ISO-639
- if { $::tcl_platform(platform) eq "windows" } {
+ if {[info sharedlibextension] eq ".dll"} {
variable WinRegToISO639 [dict create {*}{
01 ar 0401 ar_SA 0801 ar_IQ 0c01 ar_EG 1001 ar_LY 1401 ar_DZ
1801 ar_MA 1c01 ar_TN 2001 ar_OM 2401 ar_YE 2801 ar_SY
@@ -66,8 +66,8 @@ namespace eval msgcat {
15 pl 0415 pl_PL
16 pt 0416 pt_BR 0816 pt_PT
17 rm 0417 rm_CH
- 18 ro 0418 ro_RO
- 19 ru
+ 18 ro 0418 ro_RO 0818 ro_MO
+ 19 ru 0819 ru_MO
1a hr 041a hr_HR 081a sr_YU 0c1a sr_YU@cyrillic
1b sk 041b sk_SK
1c sq 041c sq_AL
@@ -92,6 +92,7 @@ namespace eval msgcat {
2f mk 042f mk_MK
30 bnt 0430 bnt_TZ
31 ts 0431 ts_ZA
+ 32 tn
33 ven 0433 ven_ZA
34 xh 0434 xh_ZA
35 zu 0435 zu_ZA
@@ -426,7 +427,7 @@ proc msgcat::ConvertLocale {value} {
# Initialize the default locale
proc msgcat::Init {} {
- global env tcl_platform
+ global env
#
# set default locale, try to get from environment
@@ -451,23 +452,48 @@ proc msgcat::Init {} {
}
}
#
- # The rest of this routine is special processing for Windows;
- # all other platforms, get out now.
+ # The rest of this routine is special processing for Windows or
+ # Cygwin. All other platforms, get out now.
#
- if {$tcl_platform(platform) ne "windows"} {
+ if {([info sharedlibextension] ne ".dll")
+ || [catch {package require registry}]} {
mclocale C
return
}
#
- # On Windows, try to set locale depending on registry settings,
- # or fall back on locale of "C".
+ # On Windows or Cygwin, try to set locale depending on registry
+ # settings, or fall back on locale of "C".
#
+
+ # First check registry value LocalName present from Windows Vista
+ # which contains the local string as RFC5646, composed of:
+ # [a-z]{2,3} : language
+ # -[a-z]{4} : script (optional, not used)
+ # -[a-z]{2}|[0-9]{3} : territory (optional, numerical region codes not used)
+ # (-.*)* : variant, extension, private use (optional, not used)
+ # Those are translated to local strings.
+ # Examples: de-CH -> de_ch, sr-Latn-CS -> sr_cs, es-419 -> es
+ #
+ set key {HKEY_CURRENT_USER\Control Panel\International}
+ if {([registry values $key "LocaleName"] ne "")
+ && [regexp {^([a-z]{2,3})(?:-[a-z]{4})?(?:-([a-z]{2}))?(?:-.+)?$}\
+ [string tolower [registry get $key "LocaleName"]] match locale\
+ territory]} {
+ if {"" ne $territory} {
+ append locale _ $territory
+ }
+ if {![catch {
+ mclocale [ConvertLocale $locale]
+ }]} {
+ return
+ }
+ }
+
+ # then check key locale which contains a numerical language ID
if {[catch {
- package require registry
- set key {HKEY_CURRENT_USER\Control Panel\International}
set locale [registry get $key "locale"]
}]} {
- mclocale C
+ mclocale C
return
}
#
diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl
index 17ad5db..60c2d3c 100644
--- a/library/msgcat/pkgIndex.tcl
+++ b/library/msgcat/pkgIndex.tcl
@@ -1,2 +1,2 @@
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
-package ifneeded msgcat 1.4.4 [list source [file join $dir msgcat.tcl]]
+package ifneeded msgcat 1.4.5 [list source [file join $dir msgcat.tcl]]
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 067425f..f71b09f 100755
--- a/library/reg/pkgIndex.tcl
+++ b/library/reg/pkgIndex.tcl
@@ -1,9 +1,9 @@
if {![package vsatisfies [package provide Tcl] 8.5]} return
-if {[string compare [info sharedlibextension] .dll]} return
+if {[info sharedlibextension] ne ".dll"} return
if {[::tcl::pkgconfig get debug]} {
- package ifneeded registry 1.3 \
+ package ifneeded registry 1.3.0 \
[list load [file join $dir tclreg13g.dll] registry]
} else {
- package ifneeded registry 1.3 \
+ package ifneeded registry 1.3.0 \
[list load [file join $dir tclreg13.dll] registry]
}
diff --git a/tests/encoding.test b/tests/encoding.test
index 51b7aa1..b4ee7c3 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -582,6 +582,14 @@ file delete {*}[glob -directory [temporaryDirectory] *.chars *.tcltestout]
# EscapeFreeProc, GetTableEncoding, unilen are fully tested by the rest of
# this file.
+
+test encoding-27.1 {encoding dirs basic behavior} -returnCodes error -body {
+ encoding dirs ? ?
+} -result {wrong # args: should be "encoding dirs ?dirList?"}
+test encoding-27.2 {encoding dirs basic behavior} -returnCodes error -body {
+ encoding dirs "\{not a list"
+} -result "expected directory list but got \"\{not a list\""
+
}
runtests
diff --git a/tests/fCmd.test b/tests/fCmd.test
index f2adcef..72b7da9 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -39,6 +39,7 @@ if {[testConstraint win]} {
}
}
+set tmpspace /tmp;# default value
# Find a group that exists on this Unix system, or else skip tests that
# require Unix groups.
testConstraint foundGroup [expr {![testConstraint unix]}]
@@ -591,7 +592,7 @@ test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup {
[subst {error renaming "td2" to "[file join td1 td2]": file *}]
test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} -setup {
cleanup $tmpspace
-} -constraints {xdev notRoot} -body {
+} -constraints {unix notRoot} -body {
createfile tf1
file rename tf1 $tmpspace
glob -nocomplain tf* [file join $tmpspace tf1]
@@ -610,21 +611,21 @@ test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup {
} -result {d:/tcl8975@}
test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} -setup {
cleanup $tmpspace
-} -constraints {xdev notRoot} -body {
+} -constraints {unix notRoot} -body {
file mkdir td1
file rename td1 $tmpspace
glob -nocomplain td* [file join $tmpspace td*]
} -result [file join $tmpspace td1]
test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} -setup {
cleanup $tmpspace
-} -constraints {xdev notRoot} -body {
+} -constraints {unix notRoot} -body {
createfile tf1
file rename tf1 $tmpspace
glob -nocomplain tf* [file join $tmpspace tf*]
} -result [file join $tmpspace tf1]
test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
cleanup $tmpspace
-} -constraints {notRoot xdev} -body {
+} -constraints {xdev notRoot} -body {
file mkdir td1/td2/td3
file attributes td1 -permissions 0000
file rename td1 $tmpspace
@@ -693,7 +694,7 @@ test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup {
} -result [file join $tmpspace td1 td2]
test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup {
cleanup $tmpspace
-} -constraints {xdev notRoot} -body {
+} -constraints {unix notRoot} -body {
file mkdir foo/bar
file attr foo -perm 040555
file rename foo/bar $tmpspace
@@ -1353,7 +1354,7 @@ test fCmd-12.8 {renamefile: generic error} -setup {
} -result {1}
test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
cleanup $tmpspace
-} -constraints {xdev notRoot} -body {
+} -constraints {unix notRoot} -body {
set s [createfile tfa]
file rename tfa $tmpspace
list [checkcontent [file join $tmpspace tfa] $s] [file exists tfa]
diff --git a/tests/fileName.test b/tests/fileName.test
index affacff..251f12c 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -196,7 +196,7 @@ test filename-4.12 {Tcl_SplitPath: unix} {testsetplatform} {
test filename-4.13 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split //foo
-} {/ foo}
+} "[file split //] foo"
test filename-4.14 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split foo//bar
@@ -433,11 +433,11 @@ test filename-7.16 {Tcl_JoinPath: unix} {testsetplatform} {
test filename-7.17 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join //a b
-} {/a/b}
+} "[file split //]a/b"
test filename-7.18 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join /// a b
-} {/a/b}
+} "[file split //]a/b"
test filename-9.1 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
diff --git a/tests/msgcat.test b/tests/msgcat.test
index 0669810..bbcd023 100644
--- a/tests/msgcat.test
+++ b/tests/msgcat.test
@@ -17,8 +17,8 @@ if {[catch {package require tcltest 2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2 required."
return
}
-if {[catch {package require msgcat 1.4.2}]} {
- puts stderr "Skipping tests in [info script]. No msgcat 1.4.2 found to test."
+if {[catch {package require msgcat 1.4.5}]} {
+ puts stderr "Skipping tests in [info script]. No msgcat 1.4.5 found to test."
return
}
diff --git a/tests/registry.test b/tests/registry.test
index 7234a32..400277f 100644
--- a/tests/registry.test
+++ b/tests/registry.test
@@ -505,6 +505,12 @@ test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} {
registry delete HKEY_CURRENT_USER\\TclFoobar
set result
} "foo ba r baz"
+test registry-6.21 {GetValue: very long value names and values} {pcOnly} {
+ registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383] [string repeat x 16383] multi_sz
+ set result [registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383]]
+ registry delete HKEY_CURRENT_USER\\TclFoobar
+ set result
+} [string repeat x 16383]
test registry-7.1 {GetValueNames: bad key} -constraints {win reg english} -setup {
registry delete HKEY_CURRENT_USER\\TclFoobar
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 0c63c3f..2e47714 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -238,7 +238,7 @@ DLTEST_DIR = @TCL_SRC_DIR@/unix/dltest
# Must be absolute to so the corresponding tcltest's tcl_library is absolute.
TCL_BUILDTIME_LIBRARY = @TCL_SRC_DIR@/library
-ZLIB_DIR = @ZLIB_DIR@
+ZLIB_DIR = ${COMPAT_DIR}/zlib
ZLIB_INCLUDE = @ZLIB_INCLUDE@
CC = @CC@
@@ -614,6 +614,10 @@ doc:
${LIB_FILE}: ${OBJS} ${STUB_LIB_FILE}
rm -f $@
@MAKE_LIB@
+ @if test "x$(DLL_INSTALL_DIR)" = "x$(BIN_INSTALL_DIR)"; then\
+ cp ${ZLIB_DIR}/win32/zlib1.dll .;\
+ fi
+
${STUB_LIB_FILE}: ${STUB_LIB_OBJS}
rm -f $@
@@ -783,16 +787,21 @@ install-binaries: binaries
else true; \
fi; \
done;
+ @if test "x$(DLL_INSTALL_DIR)" = "x$(BIN_INSTALL_DIR)"; then\
+ echo "Installing zlib1.dll to $(BIN_INSTALL_DIR)/";\
+ $(INSTALL_LIBRARY) zlib1.dll "$(BIN_INSTALL_DIR)";\
+ chmod 555 "$(BIN_INSTALL_DIR)/zlib1.dll";\
+ fi
@echo "Installing $(LIB_FILE) to $(DLL_INSTALL_DIR)/"
@@INSTALL_LIB@
- @chmod 555 "$(DLL_INSTALL_DIR)"/$(LIB_FILE)
+ @chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)"
@echo "Installing ${TCL_EXE} as $(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}"
- @$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)"/tclsh$(VERSION)${EXE_SUFFIX}
+ @$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}"
@echo "Installing tclConfig.sh to $(CONFIG_INSTALL_DIR)/"
- @$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)"/tclConfig.sh
+ @$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)/tclConfig.sh"
@echo "Installing tclooConfig.sh to $(CONFIG_INSTALL_DIR)/"
@$(INSTALL_DATA) $(UNIX_DIR)/tclooConfig.sh \
- "$(CONFIG_INSTALL_DIR)"/tclooConfig.sh
+ "$(CONFIG_INSTALL_DIR)/tclooConfig.sh"
@if test "$(STUB_LIB_FILE)" != "" ; then \
echo "Installing $(STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \
@INSTALL_STUB_LIB@ ; \
@@ -837,8 +846,8 @@ install-libraries: libraries
do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
done;
- @echo "Installing package msgcat 1.4.4 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.4.tm;
+ @echo "Installing package msgcat 1.4.5 as a Tcl Module";
+ @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.5.tm;
@echo "Installing package tcltest 2.3.4 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.4.tm;
diff --git a/unix/configure b/unix/configure
index ec5a467..2e36ad2 100755
--- a/unix/configure
+++ b/unix/configure
@@ -308,7 +308,7 @@ ac_includes_default="\
# include <unistd.h>
#endif"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS TCLSH_PROG ZLIB_DIR ZLIB_OBJS ZLIB_SRCS ZLIB_INCLUDE RANLIB ac_ct_RANLIB AR ac_ct_AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT DTRACE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR PKG_CFG_ARGS TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG INSTALL_TZDATA DTRACE_SRC DTRACE_HDR DTRACE_OBJ MAKEFILE_SHELL BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR PACKAGE_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX'
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS TCLSH_PROG ZLIB_OBJS ZLIB_SRCS ZLIB_INCLUDE RANLIB ac_ct_RANLIB AR ac_ct_AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT DTRACE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR PKG_CFG_ARGS TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG INSTALL_TZDATA DTRACE_SRC DTRACE_HDR DTRACE_OBJ MAKEFILE_SHELL BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR PACKAGE_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX'
ac_subst_files=''
# Initialize some variables set by options.
@@ -6337,8 +6337,6 @@ fi
if test $zlib_ok = no; then
- ZLIB_DIR=\${COMPAT_DIR}/zlib
-
ZLIB_OBJS=\${ZLIB_OBJS}
ZLIB_SRCS=\${ZLIB_SRCS}
@@ -7132,6 +7130,16 @@ echo "${ECHO_T}$ac_cv_cygwin" >&6
echo "$as_me: error: ${CC} is not a cygwin compiler." >&2;}
{ (exit 1); exit 1; }; }
fi
+ if test "x${TCL_THREADS}" = "x0"; then
+ { { echo "$as_me:$LINENO: error: CYGWIN compile is only supported with --enable-threads" >&5
+echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+ if test "x${SHARED_BUILD}" = "x1" -a ! -f "../win/tcldde14.dll" -a ! -f "../win/tk86.dll"; then
+ { { echo "$as_me:$LINENO: error: Please configure and make the ../win directory first." >&5
+echo "$as_me: error: Please configure and make the ../win directory first." >&2;}
+ { (exit 1); exit 1; }; }
+ fi
;;
dgux*)
SHLIB_CFLAGS="-K PIC"
@@ -9142,15 +9150,15 @@ fi
if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""; then
LIB_SUFFIX=${SHARED_LIB_SUFFIX}
- MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
+ MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${TCL_SHLIB_LD_EXTRAS} ${SHLIB_LD_LIBS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
if test "${SHLIB_SUFFIX}" = ".dll"; then
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)"/$(LIB_FILE)'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)"'
DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)"
else
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE)'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'
fi
@@ -9162,12 +9170,12 @@ else
if test "$RANLIB" = ""; then
MAKE_LIB='$(STLIB_LD) $@ ${OBJS}'
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE)'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'
else
MAKE_LIB='${STLIB_LD} $@ ${OBJS} ; ${RANLIB} $@'
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE) ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))'
fi
@@ -9184,7 +9192,7 @@ fi
else
MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS} ; ${RANLIB} $@'
- INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)"/$(STUB_LIB_FILE) ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))'
+ INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))'
fi
@@ -14391,8 +14399,12 @@ _ACEOF
# lack blkcnt_t.
#--------------------------------------------------------------------
-if test "$ac_cv_cygwin" != "yes"; then
-echo "$as_me:$LINENO: checking for struct stat.st_blocks" >&5
+if test "$ac_cv_cygwin" = "yes"; then
+ if test "x${SHARED_BUILD}" = "x1"; then
+ TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS} \${COMPAT_DIR}/zlib/win32/zdll.lib"
+ fi
+else
+ echo "$as_me:$LINENO: checking for struct stat.st_blocks" >&5
echo $ECHO_N "checking for struct stat.st_blocks... $ECHO_C" >&6
if test "${ac_cv_member_struct_stat_st_blocks+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
@@ -20213,7 +20225,6 @@ s,@CPP@,$CPP,;t t
s,@EGREP@,$EGREP,;t t
s,@TCL_THREADS@,$TCL_THREADS,;t t
s,@TCLSH_PROG@,$TCLSH_PROG,;t t
-s,@ZLIB_DIR@,$ZLIB_DIR,;t t
s,@ZLIB_OBJS@,$ZLIB_OBJS,;t t
s,@ZLIB_SRCS@,$ZLIB_SRCS,;t t
s,@ZLIB_INCLUDE@,$ZLIB_INCLUDE,;t t
diff --git a/unix/configure.in b/unix/configure.in
index 726d4a8..79a546d 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -160,7 +160,6 @@ AS_IF([test $zlib_ok = yes], [
zlib_ok=no
])])
AS_IF([test $zlib_ok = no], [
- AC_SUBST(ZLIB_DIR,[\${COMPAT_DIR}/zlib])
AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])
AC_SUBST(ZLIB_SRCS,[\${ZLIB_SRCS}])
AC_SUBST(ZLIB_INCLUDE,[-I\${ZLIB_DIR}])
@@ -303,8 +302,12 @@ SC_TIME_HANDLER
# lack blkcnt_t.
#--------------------------------------------------------------------
-if test "$ac_cv_cygwin" != "yes"; then
-AC_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize])
+if test "$ac_cv_cygwin" = "yes"; then
+ if test "x${SHARED_BUILD}" = "x1"; then
+ TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS} \${COMPAT_DIR}/zlib/win32/zdll.lib"
+ fi
+else
+ AC_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize])
fi
AC_CHECK_TYPES([blkcnt_t])
AC_CHECK_FUNC(fstatfs, , [AC_DEFINE(NO_FSTATFS, 1, [Do we have fstatfs()?])])
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 85b48fa..a142baf 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -1243,6 +1243,12 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
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 "x${SHARED_BUILD}" = "x1" -a ! -f "../win/tcldde14.dll" -a ! -f "../win/tk86.dll"; then
+ AC_MSG_ERROR([Please configure and make the ../win directory first.])
+ fi
;;
dgux*)
SHLIB_CFLAGS="-K PIC"
@@ -2092,22 +2098,22 @@ dnl # preprocessing tests use only CPPFLAGS.
AS_IF([test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""], [
LIB_SUFFIX=${SHARED_LIB_SUFFIX}
- MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
+ MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${TCL_SHLIB_LD_EXTRAS} ${SHLIB_LD_LIBS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
AS_IF([test "${SHLIB_SUFFIX}" = ".dll"], [
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)"/$(LIB_FILE)'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)"'
DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)"
], [
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE)'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'
])
], [
LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}
AS_IF([test "$RANLIB" = ""], [
MAKE_LIB='$(STLIB_LD) [$]@ ${OBJS}'
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE)'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'
], [
MAKE_LIB='${STLIB_LD} [$]@ ${OBJS} ; ${RANLIB} [$]@'
- INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)"/$(LIB_FILE) ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))'
+ INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))'
])
])
@@ -2117,7 +2123,7 @@ dnl # preprocessing tests use only CPPFLAGS.
INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"'
], [
MAKE_STUB_LIB='${STLIB_LD} [$]@ ${STUB_LIB_OBJS} ; ${RANLIB} [$]@'
- INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)"/$(STUB_LIB_FILE) ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))'
+ INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))'
])
# Define TCL_LIBS now that we know what DL_LIBS is.
diff --git a/unix/tclConfig.sh.in b/unix/tclConfig.sh.in
index 7e1d4af..d47e686 100644
--- a/unix/tclConfig.sh.in
+++ b/unix/tclConfig.sh.in
@@ -1,5 +1,5 @@
# tclConfig.sh --
-#
+#
# This shell script (for sh) is generated automatically by Tcl's
# configure script. It will create shell variables for most of
# the configuration options discovered by the configure script.
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 1c456a0..e676215 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -42,19 +42,18 @@ TclpFindExecutable(
Tcl_Encoding encoding;
#ifdef __CYGWIN__
int length;
- char buf[PATH_MAX * TCL_UTF_MAX + 1];
+ char buf[PATH_MAX * 2];
char name[PATH_MAX * TCL_UTF_MAX + 1];
- GetModuleFileNameW(NULL, name, PATH_MAX);
- WideCharToMultiByte(CP_UTF8, 0, name, -1, buf, PATH_MAX, NULL, NULL);
- cygwin_conv_to_full_posix_path(buf, name);
+ GetModuleFileNameW(NULL, buf, PATH_MAX);
+ cygwin_conv_path(3, buf, name, PATH_MAX);
length = strlen(name);
if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) {
/* Strip '.exe' part. */
length -= 4;
}
- encoding = Tcl_GetEncoding(NULL, NULL);
- TclSetObjNameOfExecutable(
- Tcl_NewStringObj(name, length), encoding);
+ encoding = Tcl_GetEncoding(NULL, NULL);
+ TclSetObjNameOfExecutable(
+ Tcl_NewStringObj(name, length), encoding);
#else
const char *name, *p;
Tcl_StatBuf statBuf;
diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
index ebbbb78..c1bc430 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.c
@@ -91,9 +91,16 @@ typedef struct ThreadSpecificData {
* from these pointers. You must hold the
* notifierMutex lock before accessing these
* fields. */
+#ifdef __CYGWIN__
+ void *event; /* Any other thread alerts a notifier
+ * that an event is ready to be processed
+ * by sending this event. */
+ void *hwnd; /* Messaging window. */
+#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. */
@@ -197,6 +204,48 @@ static int FileHandlerEventProc(Tcl_Event *evPtr, int flags);
*----------------------------------------------------------------------
*/
+#if defined(TCL_THREADS) && defined(__CYGWIN__)
+
+typedef struct {
+ void *hwnd;
+ unsigned int *message;
+ int wParam;
+ int lParam;
+ int time;
+ int x;
+ int y;
+} MSG;
+
+typedef struct {
+ unsigned int style;
+ void *lpfnWndProc;
+ int cbClsExtra;
+ int cbWndExtra;
+ void *hInstance;
+ void *hIcon;
+ void *hCursor;
+ void *hbrBackground;
+ void *lpszMenuName;
+ void *lpszClassName;
+} WNDCLASS;
+
+extern unsigned char __stdcall PeekMessageW(MSG *, void *, int, int, int);
+extern unsigned char __stdcall GetMessageW(MSG *, void *, int, int);
+extern unsigned char __stdcall TranslateMessage(const MSG *);
+extern int __stdcall DispatchMessageW(const MSG *);
+extern void __stdcall PostQuitMessage(int);
+extern void * __stdcall CreateWindowExW(void *, void *, void *, DWORD, int, int, int, int, void *, void *, void *, void *);
+extern unsigned char __stdcall DestroyWindow(void *);
+extern unsigned char __stdcall PostMessageW(void *, unsigned int, void *, void *);
+extern void *__stdcall RegisterClassW(const WNDCLASS *);
+extern DWORD __stdcall DefWindowProcW(void *, int, void *, void *);
+extern void *__stdcall CreateEventW(void *, unsigned char, unsigned char, void *);
+extern void __stdcall CloseHandle(void *);
+extern void __stdcall MsgWaitForMultipleObjects(DWORD, void *, unsigned char, DWORD, DWORD);
+extern unsigned char __stdcall ResetEvent(void *);
+
+#endif
+
ClientData
Tcl_InitNotifier(void)
{
@@ -311,7 +360,11 @@ Tcl_FinalizeNotifier(
* Clean up any synchronization objects in the thread local storage.
*/
- Tcl_ConditionFinalize(&tsdPtr->waitCV);
+#ifdef __CYGWIN__
+ CloseHandle(tsdPtr->event);
+#else /* __CYGWIN__ */
+ Tcl_ConditionFinalize(&(tsdPtr->waitCV));
+#endif /* __CYGWIN__ */
Tcl_MutexUnlock(&notifierMutex);
#endif /* TCL_THREADS */
@@ -350,7 +403,11 @@ Tcl_AlertNotifier(
Tcl_MutexLock(&notifierMutex);
tsdPtr->eventReady = 1;
+#ifdef __CYGWIN__
+ PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
+#else
Tcl_ConditionNotify(&tsdPtr->waitCV);
+#endif
Tcl_MutexUnlock(&notifierMutex);
#endif /* TCL_THREADS */
}
@@ -656,6 +713,31 @@ FileHandlerEventProc(
return 1;
}
+#if defined(TCL_THREADS) && defined(__CYGWIN__)
+
+static DWORD __stdcall
+NotifierProc(
+ void *hwnd,
+ unsigned int message,
+ void *wParam,
+ void *lParam)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (message != 1024) {
+ return DefWindowProcW(hwnd, message, wParam, lParam);
+ }
+
+ /*
+ * Process all of the runnable events.
+ */
+
+ tsdPtr->eventReady = 1;
+ Tcl_ServiceAll();
+ return 0;
+}
+#endif /* __CYGWIN__ */
+
/*
*----------------------------------------------------------------------
*
@@ -686,6 +768,9 @@ Tcl_WaitForEvent(
Tcl_Time vTime;
#ifdef TCL_THREADS
int waitForFiles;
+# ifdef __CYGWIN__
+ MSG msg;
+# endif
#else
/*
* Impl. notes: timeout & timeoutPtr are used if, and only if threads
@@ -741,6 +826,30 @@ Tcl_WaitForEvent(
* notifier thread, and wait for a response or a timeout.
*/
+#ifdef __CYGWIN__
+ if (!tsdPtr->hwnd) {
+ WNDCLASS class;
+
+ class.style = 0;
+ class.cbClsExtra = 0;
+ class.cbWndExtra = 0;
+ class.hInstance = TclWinGetTclInstance();
+ class.hbrBackground = NULL;
+ class.lpszMenuName = NULL;
+ class.lpszClassName = L"TclNotifier";
+ class.lpfnWndProc = NotifierProc;
+ class.hIcon = NULL;
+ class.hCursor = NULL;
+
+ 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 */,
+ 0 /* !signaled */, NULL);
+ }
+
+#endif
+
Tcl_MutexLock(&notifierMutex);
if (timePtr != NULL && timePtr->sec == 0 && (timePtr->usec == 0
@@ -797,10 +906,40 @@ Tcl_WaitForEvent(
FD_ZERO(&tsdPtr->readyMasks.exception);
if (!tsdPtr->eventReady) {
+#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;
+#ifdef __CYGWIN__
+ while (PeekMessageW(&msg, NULL, 0, 0, 0)) {
+ /*
+ * Retrieve and dispatch the message.
+ */
+ DWORD result = GetMessageW(&msg, NULL, 0, 0);
+ if (result == 0) {
+ PostQuitMessage(msg.wParam);
+ /* What to do here? */
+ } else if (result != (DWORD)-1) {
+ TranslateMessage(&msg);
+ DispatchMessageW(&msg);
+ }
+ }
+ ResetEvent(tsdPtr->event);
+#endif
if (waitForFiles && tsdPtr->onList) {
/*
* Remove the ThreadSpecificData structure of this thread from the
@@ -1071,7 +1210,11 @@ NotifierThreadProc(
tsdPtr->onList = 0;
tsdPtr->pollState = 0;
}
- Tcl_ConditionNotify(&tsdPtr->waitCV);
+#ifdef __CYGWIN__
+ PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
+#else /* __CYGWIN__ */
+ Tcl_ConditionNotify(&tsdPtr->waitCV);
+#endif /* __CYGWIN__ */
}
}
Tcl_MutexUnlock(&notifierMutex);
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index 5229f58..63c500d 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -98,16 +98,14 @@ typedef off_t Tcl_SeekOffset;
DLLIMPORT extern __stdcall void OutputDebugStringW(const WCHAR *);
DLLIMPORT extern __stdcall int IsDebuggerPresent();
- DLLIMPORT extern int cygwin_conv_to_full_posix_path(const char *, char *);
+ DLLIMPORT extern int cygwin_conv_path(int, const void *, void *, int);
+ DLLIMPORT extern int cygwin_conv_path_list(int, const void *, void *, int);
# define USE_PUTENV 1
# define USE_PUTENV_FOR_UNSET 1
/* On Cygwin, the environment is imported from the Cygwin DLL. */
# define environ __cygwin_environ
# define timezone _timezone
DLLIMPORT extern char **__cygwin_environ;
- DLLIMPORT extern int cygwin_conv_to_win32_path(const char *, char *);
- DLLIMPORT extern int cygwin_posix_to_win32_path_list_buf_size(char *value);
- DLLIMPORT extern void cygwin_posix_to_win32_path_list(char *buf, char *value);
MODULE_SCOPE int TclOSstat(const char *name, Tcl_StatBuf *statBuf);
MODULE_SCOPE int TclOSlstat(const char *name, Tcl_StatBuf *statBuf);
#elif defined(HAVE_STRUCT_STAT64)
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 12e5a9a..1e9d4eb 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -1117,11 +1117,7 @@ Tcl_OpenTcpClient(
freeaddrinfo(addrlist);
}
if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't open socket: ",
- Tcl_PosixError(interp), NULL);
- if (errorMsg != NULL) {
- Tcl_AppendResult(interp, " (", errorMsg, ")", NULL);
- }
+ Tcl_AppendResult(interp, "couldn't open socket: ", errorMsg, NULL);
}
return NULL;
}
@@ -1261,10 +1257,11 @@ Tcl_OpenTcpServer(
* Try to record and return the most meaningful error message, i.e. the
* one from the first socket that went the farthest before it failed.
*/
- enum { START, SOCKET, BIND, LISTEN } howfar = START;
+ enum { LOOKUP, SOCKET, BIND, LISTEN } howfar = LOOKUP;
int my_errno = 0;
if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, &errorMsg)) {
+ my_errno = errno;
goto error;
}
@@ -1392,11 +1389,12 @@ Tcl_OpenTcpServer(
return statePtr->channel;
}
if (interp != NULL) {
- errno = my_errno;
- Tcl_AppendResult(interp, "couldn't open socket: ",
- Tcl_PosixError(interp), NULL);
- if (errorMsg != NULL) {
- Tcl_AppendResult(interp, " (", errorMsg, ")", NULL);
+ Tcl_AppendResult(interp, "couldn't open socket: ", NULL);
+ if (errorMsg == NULL) {
+ errno = my_errno;
+ Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL);
+ } else {
+ Tcl_AppendResult(interp, errorMsg, NULL);
}
}
if (sock != -1) {
diff --git a/win/Makefile.in b/win/Makefile.in
index 44ba581..d5a335d 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -669,8 +669,8 @@ install-libraries: libraries install-tzdata install-msgs
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
done;
- @echo "Installing package msgcat 1.4.4 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.4.tm;
+ @echo "Installing package msgcat 1.4.5 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.5.tm;
@echo "Installing package tcltest 2.3.4 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.4.tm;
@echo "Installing package platform 1.0.10 as a Tcl Module";
diff --git a/win/tclWinError.c b/win/tclWinError.c
index 63e9598..49eeed3 100644
--- a/win/tclWinError.c
+++ b/win/tclWinError.c
@@ -410,6 +410,12 @@ tclWinDebugPanic(
fprintf(stderr, "\n");
fflush(stderr);
}
+# if defined(__GNUC__)
+ __builtin_trap();
+# else
+ DebugBreak();
+# endif
+ abort();
}
#endif
/*
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 2cc14ec..4a49b6c 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -819,6 +819,16 @@ tclWinDebugPanic(
MessageBoxW(NULL, msgString, L"Fatal Error",
MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
}
+#if defined(__GNUC__)
+ __builtin_trap();
+#elif defined(_WIN64)
+ __debugbreak();
+#elif defined(_MSC_VER)
+ _asm {int 3}
+#else
+ DebugBreak();
+#endif
+ abort();
}
/*
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 937089c..c508fdf 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -22,6 +22,13 @@
#endif
#include <stdlib.h>
+#ifndef UNICODE
+# undef Tcl_WinTCharToUtf
+# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
+# undef Tcl_WinUtfToTChar
+# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c)
+#endif
+
/*
* Ensure that we can say which registry is being accessed.
*/
@@ -34,6 +41,14 @@
#endif
/*
+ * The maximum length of a sub-key name.
+ */
+
+#ifndef MAX_KEY_LENGTH
+#define MAX_KEY_LENGTH 256
+#endif
+
+/*
* TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
* Registry_Init declaration is in the source file itself, which is only
* accessed when we are building a library.
@@ -43,6 +58,14 @@
#define TCL_STORAGE_CLASS DLLEXPORT
/*
+ * The maximum length of a sub-key name.
+ */
+
+#ifndef MAX_KEY_LENGTH
+#define MAX_KEY_LENGTH 256
+#endif
+
+/*
* The following macros convert between different endian ints.
*/
@@ -157,7 +180,7 @@ Registry_Init(
cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
interp, DeleteCmd);
Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
- return Tcl_PkgProvide(interp, "registry", "1.3");
+ return Tcl_PkgProvide(interp, "registry", "1.3.0");
}
/*
@@ -552,9 +575,7 @@ GetKeyNames(
{
const char *pattern; /* Pattern being matched against subkeys */
HKEY key; /* Handle to the key being examined */
- DWORD subKeyCount; /* Number of subkeys to list */
- DWORD maxSubKeyLen; /* Maximum string length of any subkey */
- TCHAR *buffer; /* Buffer to hold the subkey name */
+ TCHAR buffer[MAX_KEY_LENGTH]; /* Buffer to hold the subkey name */
DWORD bufSize; /* Size of the buffer */
DWORD index; /* Position of the current subkey */
char *name; /* Subkey name */
@@ -578,40 +599,27 @@ GetKeyNames(
}
/*
- * Determine how big a buffer is needed for enumerating subkeys, and how
- * many subkeys there are.
- */
-
- result = RegQueryInfoKey(key, NULL, NULL, NULL,
- &subKeyCount, &maxSubKeyLen, NULL, NULL, NULL, NULL, NULL, NULL);
- if (result != ERROR_SUCCESS) {
- Tcl_SetObjResult(interp, Tcl_NewObj());
- Tcl_AppendResult(interp, "unable to query key \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
- AppendSystemError(interp, result);
- RegCloseKey(key);
- return TCL_ERROR;
- }
- buffer = ckalloc((maxSubKeyLen+1) * sizeof(TCHAR));
-
- /*
* Enumerate the subkeys.
*/
resultPtr = Tcl_NewObj();
- for (index = 0; index < subKeyCount; ++index) {
- bufSize = maxSubKeyLen+1;
+ for (index = 0;; ++index) {
+ bufSize = MAX_KEY_LENGTH;
result = RegEnumKeyEx(key, index, buffer, &bufSize,
NULL, NULL, NULL, NULL);
if (result != ERROR_SUCCESS) {
- Tcl_SetObjResult(interp, Tcl_NewObj());
- Tcl_AppendResult(interp, "unable to enumerate subkeys of \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
- AppendSystemError(interp, result);
- result = TCL_ERROR;
+ if (result == ERROR_NO_MORE_ITEMS) {
+ result = TCL_OK;
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewObj());
+ Tcl_AppendResult(interp, "unable to enumerate subkeys of \"",
+ Tcl_GetString(keyNameObj), "\": ", NULL);
+ AppendSystemError(interp, result);
+ result = TCL_ERROR;
+ }
break;
}
- Tcl_WinTCharToUtf(buffer, bufSize * sizeof(WCHAR), &ds);
+ Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds);
name = Tcl_DStringValue(&ds);
if (pattern && !Tcl_StringMatch(name, pattern)) {
Tcl_DStringFree(&ds);
@@ -626,9 +634,10 @@ GetKeyNames(
}
if (result == TCL_OK) {
Tcl_SetObjResult(interp, resultPtr);
+ } else {
+ Tcl_DecrRefCount(resultPtr); /* BUGFIX: Don't leak on failure. */
}
- ckfree(buffer);
RegCloseKey(key);
return result;
}
@@ -756,8 +765,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/sizeof(TCHAR) - 1;
valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen);
nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
@@ -772,7 +781,7 @@ GetValue(
*/
length *= 2;
- Tcl_DStringSetLength(&data, (int) length);
+ Tcl_DStringSetLength(&data, (int) length * sizeof(TCHAR));
result = RegQueryValueEx(key, nativeValue,
NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length);
}
@@ -865,7 +874,7 @@ GetValueNames(
{
HKEY key;
Tcl_Obj *resultPtr;
- DWORD index, size, maxSize, result;
+ DWORD index, size, result;
Tcl_DString buffer, ds;
const char *pattern, *name;
@@ -878,27 +887,10 @@ GetValueNames(
return TCL_ERROR;
}
- /*
- * Query the key to determine the appropriate buffer size to hold the
- * largest value name plus the terminating null.
- */
-
- result = RegQueryInfoKey(key, NULL, NULL, NULL, NULL,
- NULL, NULL, &index, &maxSize, NULL, NULL, NULL);
- if (result != ERROR_SUCCESS) {
- Tcl_AppendResult(interp, "unable to query key \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
- AppendSystemError(interp, result);
- RegCloseKey(key);
- result = TCL_ERROR;
- goto done;
- }
- maxSize++;
-
resultPtr = Tcl_NewObj();
Tcl_DStringInit(&buffer);
Tcl_DStringSetLength(&buffer,
- (int) (maxSize*sizeof(WCHAR)));
+ (int) (MAX_KEY_LENGTH*sizeof(TCHAR)));
index = 0;
result = TCL_OK;
@@ -914,10 +906,10 @@ GetValueNames(
* each iteration because RegEnumValue smashes the old value.
*/
- size = maxSize;
+ size = MAX_KEY_LENGTH;
while (RegEnumValue(key,index, (TCHAR *)Tcl_DStringValue(&buffer),
&size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) {
- size *= 2;
+ size *= sizeof(TCHAR);
Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size,
&ds);
@@ -933,12 +925,10 @@ GetValueNames(
Tcl_DStringFree(&ds);
index++;
- size = maxSize;
+ size = MAX_KEY_LENGTH;
}
Tcl_SetObjResult(interp, resultPtr);
Tcl_DStringFree(&buffer);
-
- done:
RegCloseKey(key);
return result;
}
@@ -1180,7 +1170,7 @@ RecursiveDeleteKey(
* encoding, not UTF. */
REGSAM mode) /* Mode flags to pass. */
{
- DWORD result, size, maxSize;
+ DWORD result, size;
Tcl_DString subkey;
HKEY hKey;
REGSAM saveMode = mode;
@@ -1200,16 +1190,10 @@ RecursiveDeleteKey(
if (result != ERROR_SUCCESS) {
return result;
}
- result = RegQueryInfoKey(hKey, NULL, NULL, NULL, NULL,
- &maxSize, NULL, NULL, NULL, NULL, NULL, NULL);
- maxSize++;
- if (result != ERROR_SUCCESS) {
- return result;
- }
Tcl_DStringInit(&subkey);
Tcl_DStringSetLength(&subkey,
- (int) (maxSize * sizeof(WCHAR)));
+ (int) (MAX_KEY_LENGTH * sizeof(TCHAR)));
mode = saveMode;
while (result == ERROR_SUCCESS) {
@@ -1217,7 +1201,7 @@ RecursiveDeleteKey(
* Always get index 0 because key deletion changes ordering.
*/
- size = maxSize;
+ size = MAX_KEY_LENGTH;
result = RegEnumKeyEx(hKey, 0, (TCHAR *)Tcl_DStringValue(&subkey),
&size, NULL, NULL, NULL, NULL);
if (result == ERROR_NO_MORE_ITEMS) {
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index f0c2251..166fdfd 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1280,9 +1280,14 @@ CreateSocket(
}
if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't open socket: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_AppendResult(interp, "couldn't open socket: ", NULL);
+ if (errorMsg == NULL) {
+ Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL);
+ } else {
+ Tcl_AppendResult(interp, errorMsg, NULL);
+ }
}
+
if (sock != INVALID_SOCKET) {
closesocket(sock);
}