merge trunk

5 files changed, 75 insertions, 70 deletions

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);
     }