merge core-8-6-branch

7 files changed, 118 insertions, 26 deletions

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 6d5676b..f56da8f 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -3984,10 +3984,12 @@ UnstackExpiredCatches(
 
     while (catchDepth > bbPtr->catchDepth) {
 	--catchDepth;
-	range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
-	range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
-	catches[catchDepth] = NULL;
-	catchIndices[catchDepth] = -1;
+	if (catches[catchDepth] != NULL) {
+	    range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
+	    range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
+	    catches[catchDepth] = NULL;
+	    catchIndices[catchDepth] = -1;
+	}
     }
 
     /*
diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl
index 49fd1ac..b1fe234 100755
--- a/library/reg/pkgIndex.tcl
+++ b/library/reg/pkgIndex.tcl
@@ -1,9 +1,9 @@
 if {([info commands ::tcl::pkgconfig] eq "")
 	|| ([info sharedlibextension] ne ".dll")} return
 if {[::tcl::pkgconfig get debug]} {
-    package ifneeded registry 1.3.1 \
+    package ifneeded registry 1.3.2 \
             [list load [file join $dir tclreg13g.dll] registry]
 } else {
-    package ifneeded registry 1.3.1 \
+    package ifneeded registry 1.3.2 \
             [list load [file join $dir tclreg13.dll] registry]
 }
diff --git a/tests/assemble.test b/tests/assemble.test
index b0487e6..a9c77e3 100644
--- a/tests/assemble.test
+++ b/tests/assemble.test
@@ -3279,6 +3279,92 @@ test assemble-51.4 {memory leak testing} memory {
 	}
     }
 } 0
+
+test assemble-52.1 {Bug 3154ea2759} {
+    apply {{} {
+	# Needs six exception ranges to force the range allocations to use the
+	# malloced store.
+	::tcl::unsupported::assemble {
+	    beginCatch @badLabel
+	    push error
+	    push testing
+	    invokeStk 2
+	    pop
+	    push 0
+	    jump @okLabel
+	    label @badLabel
+	    push 1;		# should be pushReturnCode
+	    label @okLabel
+	    endCatch
+	    pop
+	    
+	    beginCatch @badLabel2
+	    push error
+	    push testing
+	    invokeStk 2
+	    pop
+	    push 0
+	    jump @okLabel2
+	    label @badLabel2
+	    push 1;		# should be pushReturnCode
+	    label @okLabel2
+	    endCatch
+	    pop
+	    
+	    beginCatch @badLabel3
+	    push error
+	    push testing
+	    invokeStk 2
+	    pop
+	    push 0
+	    jump @okLabel3
+	    label @badLabel3
+	    push 1;		# should be pushReturnCode
+	    label @okLabel3
+	    endCatch
+	    pop
+	    
+	    beginCatch @badLabel4
+	    push error
+	    push testing
+	    invokeStk 2
+	    pop
+	    push 0
+	    jump @okLabel4
+	    label @badLabel4
+	    push 1;		# should be pushReturnCode
+	    label @okLabel4
+	    endCatch
+	    pop
+	    
+	    beginCatch @badLabel5
+	    push error
+	    push testing
+	    invokeStk 2
+	    pop
+	    push 0
+	    jump @okLabel5
+	    label @badLabel5
+	    push 1;		# should be pushReturnCode
+	    label @okLabel5
+	    endCatch
+	    pop
+	    
+	    beginCatch @badLabel6
+	    push error
+	    push testing
+	    invokeStk 2
+	    pop
+	    push 0
+	    jump @okLabel6
+	    label @badLabel6
+	    push 1;		# should be pushReturnCode
+	    label @okLabel6
+	    endCatch
+	    pop
+	}
+    }}
+} {};				# must not crash
 
 rename fillTables {}
 rename assemble {}
diff --git a/tests/registry.test b/tests/registry.test
index 0f78212..2072559 100644
--- a/tests/registry.test
+++ b/tests/registry.test
@@ -19,7 +19,7 @@ testConstraint reg 0
 if {[testConstraint win]} {
     if {![catch {
 	    ::tcltest::loadTestedCommands
-	    set ::regver [package require registry 1.3.1]
+	    set ::regver [package require registry 1.3.2]
 	}]} {
 	testConstraint reg 1
     }
@@ -33,7 +33,7 @@ testConstraint english [expr {
 
 test registry-1.0 {check if we are testing the right dll} {win reg} {
     set ::regver
-} {1.3.1}
+} {1.3.2}
 test registry-1.1 {argument parsing for registry command} {win reg} {
     list [catch {registry} msg] $msg
 } {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
diff --git a/win/Makefile.in b/win/Makefile.in
index 3646587..6599b24 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -715,14 +715,14 @@ test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE)
 	./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
 	-load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
 	package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
-	package ifneeded registry 1.3.1 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
+	package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
 
 # Useful target to launch a built tclsh with the proper path,...
 runtest: binaries $(TCLSH) $(TEST_DLL_FILE)
 	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
 	./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
 	package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
-	package ifneeded registry 1.3.1 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
+	package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
 
 # This target can be used to run tclsh from the build directory via
 # `make shell SCRIPT=foo.tcl`
diff --git a/win/makefile.vc b/win/makefile.vc
index 2e04f15..ec7afac 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -590,13 +590,13 @@ test-core: setup $(TCLTEST) dlls $(CAT32)
 !if "$(OS)" == "Windows_NT"  || "$(MSVCDIR)" == "IDE"

 	$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<

 		package ifneeded dde 1.4.0 [list load "$(TCLDDELIB:\=/)" dde]

-		package ifneeded registry 1.3.1 [list load "$(TCLREGLIB:\=/)" registry]

+		package ifneeded registry 1.3.2 [list load "$(TCLREGLIB:\=/)" registry]

 <<

 !else

 	@echo Please wait while the tests are collected...

 	$(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log

 		package ifneeded dde 1.4.0 "$(TCLDDELIB:\=/)" dde]

-		package ifneeded registry 1.3.1 "$(TCLREGLIB:\=/)" registry]

+		package ifneeded registry 1.3.2 "$(TCLREGLIB:\=/)" registry]

 <<

 	type tests.log | more

 !endif

diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 56aa991..5f7fd31 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -163,7 +163,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.1");
+    return Tcl_PkgProvide(interp, "registry", "1.3.2");
 }
 
 /*
@@ -803,17 +803,17 @@ GetValue(
 	 * we get bogus data.
 	 */
 
-	while ((p < end) && *((Tcl_UniChar *) p) != 0) {
-	    Tcl_UniChar *up;
+	while ((p < end) && *((WCHAR *) p) != 0) {
+	    WCHAR *wp;
 
 	    Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf);
 	    Tcl_ListObjAppendElement(interp, resultPtr,
 		    Tcl_NewStringObj(Tcl_DStringValue(&buf),
 			    Tcl_DStringLength(&buf)));
-	    up = (Tcl_UniChar *) p;
+	    wp = (WCHAR *) p;
 
-	    while (*up++ != 0) {/* empty body */}
-	    p = (char *) up;
+	    while (*wp++ != 0) {/* empty body */}
+	    p = (char *) wp;
 	    Tcl_DStringFree(&buf);
 	}
 	Tcl_SetObjResult(interp, resultPtr);
@@ -1332,7 +1332,7 @@ SetValue(
 	data = (char *) Tcl_WinUtfToTChar(data, length, &buf);
 
 	/*
-	 * Include the null in the length, padding if needed for Unicode.
+	 * Include the null in the length, padding if needed for WCHAR.
 	 */
 
 	Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
@@ -1393,9 +1393,10 @@ BroadcastValue(
     DWORD_PTR sendResult;
     int timeout = 3000;
     size_t len;
-    int unilen;
     const char *str;
     Tcl_Obj *objPtr;
+    WCHAR *wstr;
+    Tcl_DString ds;
 
     if (objc == 3) {
 	str = Tcl_GetString(objv[1]);
@@ -1408,9 +1409,11 @@ BroadcastValue(
 	}
     }
 
-    str = (char*)Tcl_GetUnicodeFromObj(objv[0], &unilen);
-    if (unilen == 0) {
-	str = NULL;
+    str = Tcl_GetString(objv[0]);
+    len = objv[0]->length;
+    wstr = (WCHAR *) Tcl_WinUtfToTChar(str, len, &ds);
+    if (Tcl_DStringLength(&ds) == 0) {
+	wstr = NULL;
     }
 
     /*
@@ -1418,11 +1421,12 @@ BroadcastValue(
      */
 
     result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE,
-	    (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, (UINT) timeout, &sendResult);
+	    (WPARAM) 0, (LPARAM) wstr, SMTO_ABORTIFHUNG, (UINT) timeout, &sendResult);
+    Tcl_DStringFree(&ds);
 
     objPtr = Tcl_NewObj();
-    Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) result));
-    Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) sendResult));
+    Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) result));
+    Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) sendResult));
     Tcl_SetObjResult(interp, objPtr);
 
     return TCL_OK;