merge 9.0

15 files changed, 81 insertions, 58 deletions

diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 5094a88..1e68415 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -2740,13 +2740,13 @@ BinaryEncodeUu(
 {
     Tcl_Obj *resultObj;
     unsigned char *data, *start, *cursor;
-    int i, bits, index;
+    int i, bits;
     unsigned int n;
     int lineLength = 61;
     const unsigned char SingleNewline[] = { UCHAR('\n') };
     const unsigned char *wrapchar = SingleNewline;
     Tcl_Size j, rawLength, offset, count = 0, wrapcharlen = sizeof(SingleNewline);
-    enum { OPT_MAXLEN, OPT_WRAPCHAR };
+    enum { OPT_MAXLEN, OPT_WRAPCHAR } index;
     static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };
 
     if (objc < 2 || objc % 2 != 0) {
@@ -2805,8 +2805,6 @@ BinaryEncodeUu(
 		return TCL_ERROR;
 	    }
 	    break;
-	default:
-	    TCL_UNREACHABLE();
 	}
     }
 
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 5acb014..fb4ec83 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -4745,7 +4745,7 @@ NamespaceWhichCmd(
     static const char *const opts[] = {
 	"-command", "-variable", NULL
     };
-    int lookupType = 0;
+    enum { OPT_COMMAND, OPT_VARIABLE } lookupType = OPT_COMMAND;
     Tcl_Obj *resultPtr;
 
     if (objc < 2 || objc > 3) {
@@ -4770,14 +4770,15 @@ NamespaceWhichCmd(
 
     TclNewObj(resultPtr);
     switch (lookupType) {
-    case 0:;				/* -command */
+    case OPT_COMMAND: {
 	Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objv[objc-1]);
 
 	if (cmd != NULL) {
 	    Tcl_GetCommandFullName(interp, cmd, resultPtr);
 	}
 	break;
-    case 1:;				/* -variable */
+    }
+    case OPT_VARIABLE: {
 	Tcl_Var var = Tcl_FindNamespaceVar(interp,
 		TclGetString(objv[objc-1]), NULL, /*flags*/ 0);
 
@@ -4785,8 +4786,7 @@ NamespaceWhichCmd(
 	    Tcl_GetVariableFullName(interp, var, resultPtr);
 	}
 	break;
-    default:
-	TCL_UNREACHABLE();
+    }
     }
     Tcl_SetObjResult(interp, resultPtr);
     return TCL_OK;
diff --git a/generic/tclTest.c b/generic/tclTest.c
index c67ec25..e6c2a94 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -41,8 +41,14 @@
 /*
  * Declare external functions used in Windows tests.
  */
+#ifdef __cplusplus
+extern "C" {
+#endif
 DLLEXPORT int		Tcltest_Init(Tcl_Interp *interp);
 DLLEXPORT int		Tcltest_SafeInit(Tcl_Interp *interp);
+#ifdef __cplusplus
+}
+#endif
 
 /*
  * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 52493c1..faaf92a 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -139,7 +139,13 @@ static void		ThreadFreeProc(void *clientData);
 static int		ThreadDeleteEvent(Tcl_Event *eventPtr,
 			    void *clientData);
 static void		ThreadExitProc(void *clientData);
+#ifdef __cplusplus
+extern "C" {
+#endif
 extern int		Tcltest_Init(Tcl_Interp *interp);
+#ifdef __cplusplus
+}
+#endif
 
 /*
  *----------------------------------------------------------------------
diff --git a/tests/aaa_exit.test b/tests/aaa_exit.test
index 324c7a8..5957640 100644
--- a/tests/aaa_exit.test
+++ b/tests/aaa_exit.test
@@ -16,7 +16,11 @@ if {"::tcltest" ni [namespace children]} {
     namespace import -force ::tcltest::*
 }
 
-test exit-1.1 {normal, quick exit} {
+testConstraint noappverifier [expr {
+        [llength [info commands testappverifierpresent]] == 0
+        || ![testappverifierpresent]}]
+
+test exit-1.1 {normal, quick exit} -constraints noappverifier -body {
     set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 0;exit}\"" r]
     set aft [after 1000 {set done "Quick exit hangs !!!"}]
     fileevent $f readable {after cancel $aft;set done OK}
@@ -30,9 +34,9 @@ test exit-1.1 {normal, quick exit} {
 	}
     }
     set done
-} OK
+} -result OK
 
-test exit-1.2 {full-finalized exit} {
+test exit-1.2 {full-finalized exit} -constraints noappverifier -body {
     set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 1;exit}\"" r]
     set aft [after 1000 {set done "Full-finalized exit hangs !!!"}]
     fileevent $f readable {after cancel $aft;set done OK}
@@ -46,7 +50,7 @@ test exit-1.2 {full-finalized exit} {
 	}
     }
     set done
-} OK
+} -result OK
 
 
 # cleanup
diff --git a/tests/chanio.test b/tests/chanio.test
index 704b887..da850f4 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -18,6 +18,10 @@ if {"::tcltest" ni [namespace children]} {
     namespace import -force ::tcltest::*
 }
 
+testConstraint noappverifier [expr {
+        [llength [info commands testappverifierpresent]] == 0
+        || ![testappverifierpresent]}]
+
 namespace eval ::tcl::test::io {
 
     if {"::tcltest" ni [namespace children]} {
@@ -1039,7 +1043,7 @@ test chan-io-6.55 {Tcl_GetsObj: overconverted} -body {
 test chan-io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} -setup {
     update
     variable x {}
-} -constraints {stdio fileevent} -body {
+} -constraints {stdio fileevent noappverifier} -body {
     set f [openpipe w+ $path(cat)]
     chan configure $f -buffering none
     chan puts -nonewline $f "foobar"
@@ -1476,7 +1480,7 @@ test chan-io-13.5 {TranslateInputEOL: crlf mode: naked lf} -body {
 test chan-io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} -setup {
     variable x {}
     variable y {}
-} -constraints {stdio testchannel fileevent} -body {
+} -constraints {stdio testchannel fileevent noappverifier} -body {
     # (chanPtr->flags & INPUT_SAW_CR)
     # This test may fail on slower machines.
     set f [openpipe w+ $path(cat)]
@@ -2198,7 +2202,7 @@ test chan-io-28.6 {Tcl_CloseEx (half-close) pipe} -setup {
 	exit 0
     } cat.tcl]
     variable done
-} -body {
+} -constraints noappverifier -body {
     set ff [openpipe r+ $cat]
     puts $ff Hey
     close $ff w
diff --git a/tests/clock.test b/tests/clock.test
index b69808c..e1bbc88 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -25,6 +25,13 @@ if {[testConstraint win]} {
     }
 }
 
+# Application Verifier hooks system calls in a way that locale
+# detection fails. Disable tests that depend on that if
+# it is running.
+testConstraint noappverifier [expr {
+        [llength [info commands testappverifierpresent]] == 0
+        || ![testappverifierpresent]}]
+
 package require msgcat 1.4
 
 testConstraint detroit \
@@ -35943,7 +35950,7 @@ test clock-30.34 {regression test - clock add jump over DST hole with TZ (1 day
 
 
 test clock-31.1 {system locale} \
-    -constraints win \
+    -constraints {win noappverifier} \
     -setup {
 	namespace eval ::tcl::clock {
 	    namespace import -force ::testClock::registry
@@ -35966,7 +35973,7 @@ test clock-31.1 {system locale} \
 		 -format {%d-%b-%Y}]
 
 test clock-31.2 {system locale} \
-    -constraints win \
+    -constraints {win noappverifier} \
     -setup {
 	namespace eval ::tcl::clock {
 	    namespace import -force ::testClock::registry
@@ -35989,7 +35996,7 @@ test clock-31.2 {system locale} \
 		 -format {the %d' day of %B %Y}]
 
 test clock-31.3 {system locale} \
-    -constraints win \
+    -constraints {win noappverifier} \
     -setup {
 	namespace eval ::tcl::clock {
 	    namespace import -force ::testClock::registry
@@ -36012,7 +36019,7 @@ test clock-31.3 {system locale} \
 		 -format {%l:%M:%S %p}]
 
 test clock-31.4 {system locale} \
-    -constraints win \
+    -constraints {win noappverifier} \
     -setup {
 	namespace eval ::tcl::clock {
 	    namespace import -force ::testClock::registry
@@ -36049,7 +36056,7 @@ test clock-31.4 {system locale} \
 		 -format {%d-%b-%Y}]
 
 test clock-31.5 {system locale} \
-    -constraints win \
+    -constraints {win noappverifier} \
     -setup {
 	namespace eval ::tcl::clock {
 	    namespace import -force ::testClock::registry
@@ -36086,7 +36093,7 @@ test clock-31.5 {system locale} \
 		 -format {the %d' day of %B %Y}]
 
 test clock-31.6 {system locale} \
-    -constraints win \
+    -constraints {win noappverifier} \
     -setup {
 	namespace eval ::tcl::clock {
 	    namespace import -force ::testClock::registry
@@ -37548,7 +37555,7 @@ test clock-49.1 {regression test - localtime with negative arg (Bug 1237907)} \
     -result {0 1969|1 {localtime failed \(clock value may be too large/small to represent\)}}
 
 test clock-49.2 {regression test - missing time zone file (Bug 1237907)} \
-    -constraints win \
+    -constraints {win noappverifier} \
     -setup {
 	# override the registry so that the test takes place in New York time
 	namespace eval ::tcl::clock {
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index ff282b7..3f764a0 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -16,6 +16,10 @@ if {"::tcltest" ni [namespace children]} {
     namespace import -force ::tcltest::*
 }
 
+testConstraint noappverifier [expr {
+        [llength [info commands testappverifierpresent]] == 0
+        || ![testappverifierpresent]}]
+
 namespace eval ::tcl::test::cmdMZ {
     namespace import ::tcltest::cleanupTests
     namespace import ::tcltest::customMatch
@@ -420,7 +424,10 @@ test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} {
 test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} {
     regexp {^0 \ws/# 0 # 0 #/sec 0 net-ms$} [timerate {} 0 0]
 } 1
-test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measurement} -body {
+test cmdMZ-6.6 {
+    Tcl_TimeRateObjCmd: slower commands take longer, but it
+    remains almost the same time of measurement
+} -constraints noappverifier -body {
     set m1 [timerate {_nrt_sleep 0.01} 50]
     set m2 [timerate {_nrt_sleep 1.00} 50]
     if {[testConstraint valgrind] && ([lindex $m1 0] >= 100 || [lindex $m1 2] <= 500)} {
diff --git a/tests/env.test b/tests/env.test
index 8b3f1df..2534278 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -102,12 +102,13 @@ proc cleanup1 {} {
     envrestore
 }
 
+# OANOCACHE comes from Application Verifier
 variable keep {
     TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
     SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
     DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING MSYSTEM
     __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
-    CommonProgramFiles CommonProgramFiles(x86) ProgramFiles
+    CommonProgramFiles CommonProgramFiles(x86) OANOCACHE ProgramFiles
     ProgramFiles(x86) CommonProgramW6432 ProgramW6432
     PROCESSOR_ARCHITECTURE PROCESSOR_ARCHITEW6432 USERPROFILE
     WINECONFIGDIR WINEDATADIR WINEDLLDIR0 WINEHOMEDIR
diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c
index 6158c99..8d967e8 100644
--- a/unix/tclAppInit.c
+++ b/unix/tclAppInit.c
@@ -24,8 +24,14 @@
 #endif
 
 #ifdef TCL_TEST
+#ifdef __cplusplus
+extern "C" {
+#endif
 extern Tcl_LibraryInitProc Tcltest_Init;
 extern Tcl_LibraryInitProc Tcltest_SafeInit;
+#ifdef __cplusplus
+}
+#endif
 #endif /* TCL_TEST */
 
 #ifdef TCL_XT_TEST
diff --git a/win/tclAppInit.c b/win/tclAppInit.c
index 339d61e..c293952 100644
--- a/win/tclAppInit.c
+++ b/win/tclAppInit.c
@@ -26,8 +26,14 @@
 #endif
 
 #ifdef TCL_TEST
+#ifdef __cplusplus
+extern "C" {
+#endif
 extern Tcl_LibraryInitProc Tcltest_Init;
 extern Tcl_LibraryInitProc Tcltest_SafeInit;
+#ifdef __cplusplus
+}
+#endif
 #endif /* TCL_TEST */
 
 #if defined(STATIC_BUILD)
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index 2c702fb..c37daf7 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -76,7 +76,6 @@ typedef struct TclPipeThreadInfo {
 				 * used as signal to stop (state set to -1) */
     volatile LONG state;	/* Indicates current state of the thread */
     void *clientData;		/* Referenced data of the main thread */
-    HANDLE evWakeUp;		/* Optional wake-up event worker set by shutdown */
 } TclPipeThreadInfo;
 
 /* If pipe-workers will use some tcl subsystem, we can use Tcl_Alloc without
@@ -101,7 +100,7 @@ enum PipeWorkerStates {
 
 MODULE_SCOPE
 TclPipeThreadInfo *	TclPipeThreadCreateTI(TclPipeThreadInfo **pipeTIPtr,
-			    void *clientData, HANDLE wakeEvent);
+			    void *clientData);
 MODULE_SCOPE int	TclPipeThreadWaitForSignal(
 			    TclPipeThreadInfo **pipeTIPtr);
 
@@ -123,8 +122,7 @@ TclPipeThreadIsAlive(
     return (pipeTI && pipeTI->state != PTI_STATE_DOWN);
 };
 
-MODULE_SCOPE int	TclPipeThreadStopSignal(TclPipeThreadInfo **pipeTIPtr,
-			    HANDLE wakeEvent);
+MODULE_SCOPE int	TclPipeThreadStopSignal(TclPipeThreadInfo **pipeTIPtr);
 MODULE_SCOPE void	TclPipeThreadStop(TclPipeThreadInfo **pipeTIPtr,
 			    HANDLE hThread);
 MODULE_SCOPE void	TclPipeThreadExit(TclPipeThreadInfo **pipeTIPtr);
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 2aa6d98..71d1e4b 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -1817,8 +1817,7 @@ TclpCreateCommandChannel(
 
 	infoPtr->readable = CreateEventW(NULL, TRUE, TRUE, NULL);
 	infoPtr->readThread = CreateThread(NULL, 256, PipeReaderThread,
-	    TclPipeThreadCreateTI(&infoPtr->readTI, infoPtr, infoPtr->readable),
-	    0, NULL);
+	    TclPipeThreadCreateTI(&infoPtr->readTI, infoPtr), 0, NULL);
 	SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
 	infoPtr->validMask |= TCL_READABLE;
     } else {
@@ -1832,8 +1831,7 @@ TclpCreateCommandChannel(
 
 	infoPtr->writable = CreateEventW(NULL, TRUE, TRUE, NULL);
 	infoPtr->writeThread = CreateThread(NULL, 256, PipeWriterThread,
-	    TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr, infoPtr->writable),
-	    0, NULL);
+	    TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr), 0, NULL);
 	SetThreadPriority(infoPtr->writeThread, THREAD_PRIORITY_HIGHEST);
 	infoPtr->validMask |= TCL_WRITABLE;
     } else {
@@ -2054,7 +2052,7 @@ PipeClose2Proc(
 	    if ((pipePtr->flags & PIPE_ASYNC) && inExit) {
 
 		/* give it a chance to leave honorably */
-		TclPipeThreadStopSignal(&pipePtr->writeTI, pipePtr->writable);
+		TclPipeThreadStopSignal(&pipePtr->writeTI);
 
 		if (WaitForSingleObject(pipePtr->writable, 20) == WAIT_TIMEOUT) {
 		    return EWOULDBLOCK;
@@ -3301,8 +3299,7 @@ TclpOpenTemporaryFile(
 TclPipeThreadInfo *
 TclPipeThreadCreateTI(
     TclPipeThreadInfo **pipeTIPtr,
-    void *clientData,
-    HANDLE wakeEvent)
+    void *clientData)
 {
     TclPipeThreadInfo *pipeTI;
 #ifndef _PTI_USE_CKALLOC
@@ -3313,7 +3310,6 @@ TclPipeThreadCreateTI(
     pipeTI->evControl = CreateEventW(NULL, FALSE, FALSE, NULL);
     pipeTI->state = PTI_STATE_IDLE;
     pipeTI->clientData = clientData;
-    pipeTI->evWakeUp = wakeEvent;
     return (*pipeTIPtr = pipeTI);
 }
 
@@ -3341,14 +3337,11 @@ TclPipeThreadWaitForSignal(
     TclPipeThreadInfo *pipeTI = *pipeTIPtr;
     LONG state;
     DWORD waitResult;
-    HANDLE wakeEvent;
 
     if (!pipeTI) {
 	return 0;
     }
 
-    wakeEvent = pipeTI->evWakeUp;
-
     /*
      * Wait for the main thread to signal before attempting to do the work.
      */
@@ -3408,11 +3401,6 @@ TclPipeThreadWaitForSignal(
 
     if (state != PTI_STATE_STOP) {
 	*pipeTIPtr = NULL;
-    } else {
-	pipeTI->evWakeUp = NULL;
-    }
-    if (wakeEvent) {
-	SetEvent(wakeEvent);
     }
     return 0;
 }
@@ -3435,8 +3423,7 @@ TclPipeThreadWaitForSignal(
 
 int
 TclPipeThreadStopSignal(
-    TclPipeThreadInfo **pipeTIPtr,
-    HANDLE wakeEvent)
+    TclPipeThreadInfo **pipeTIPtr)
 {
     TclPipeThreadInfo *pipeTI = *pipeTIPtr;
     HANDLE evControl;
@@ -3446,7 +3433,6 @@ TclPipeThreadStopSignal(
 	return 1;
     }
     evControl = pipeTI->evControl;
-    pipeTI->evWakeUp = wakeEvent;
     state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_STOP,
 	    PTI_STATE_IDLE);
     switch (state) {
@@ -3510,7 +3496,6 @@ TclPipeThreadStop(
     }
     pipeTI = *pipeTIPtr;
     evControl = pipeTI->evControl;
-    pipeTI->evWakeUp = NULL;
 
     /*
      * Try to sane stop the pipe worker, corresponding its current state
@@ -3662,9 +3647,6 @@ TclPipeThreadStop(
 
     *pipeTIPtr = NULL;
     if (pipeTI) {
-	if (pipeTI->evWakeUp) {
-	    SetEvent(pipeTI->evWakeUp);
-	}
 	CloseHandle(pipeTI->evControl);
 #ifndef _PTI_USE_CKALLOC
 	free(pipeTI);
@@ -3713,9 +3695,6 @@ TclPipeThreadExit(
     state = InterlockedExchange(&pipeTI->state, PTI_STATE_DOWN);
     if (state == PTI_STATE_STOP) {
 	CloseHandle(pipeTI->evControl);
-	if (pipeTI->evWakeUp) {
-	    SetEvent(pipeTI->evWakeUp);
-	}
 #ifndef _PTI_USE_CKALLOC
 	free(pipeTI);
 #else
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index 690183c..48baaa8 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -1506,8 +1506,7 @@ TclWinOpenSerialChannel(
 	infoPtr->osWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL);
 	infoPtr->evWritable = CreateEventW(NULL, TRUE, TRUE, NULL);
 	infoPtr->writeThread = CreateThread(NULL, 256, SerialWriterThread,
-		TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr,
-			infoPtr->evWritable), 0, NULL);
+		TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr), 0, NULL);
     }
 
     Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 29f1737..2784962 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -546,7 +546,7 @@ TclpFinalizeSockets(void)
 	     * completely cleaned up before we leave this function.
 	     */
 
-	    WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
+	    WaitForSingleObject(tsdPtr->socketThread, INFINITE);
 	    tsdPtr->hwnd = NULL;
 	}
 	CloseHandle(tsdPtr->socketThread);
@@ -2221,6 +2221,7 @@ Tcl_OpenTcpServerEx(
 		addrPtr->ai_addrlen) == SOCKET_ERROR) {
 	    Tcl_WinConvertError((DWORD) WSAGetLastError());
 	    closesocket(sock);
+	    sock = INVALID_SOCKET; /* Bug [40b1814b93] */
 	    continue;
 	}
 	if (port == 0 && chosenport == 0) {
@@ -2249,6 +2250,7 @@ Tcl_OpenTcpServerEx(
 	if (listen(sock, backlog) == SOCKET_ERROR) {
 	    Tcl_WinConvertError((DWORD) WSAGetLastError());
 	    closesocket(sock);
+	    sock = INVALID_SOCKET; /* Bug [40b1814b93] */
 	    continue;
 	}