Merge 8.7

10 files changed, 82 insertions, 79 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index a92680d..705ec3a 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2427,10 +2427,17 @@ const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
 #endif
 
 #ifdef USE_TCL_STUBS
+# if TCL_UTF_MAX < 4
 #   define Tcl_InitStubs(interp, version, exact) \
 	(Tcl_InitStubs)(interp, version, \
 	    (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
 	    TCL_STUB_MAGIC)
+# else
+#   define Tcl_InitStubs(interp, version, exact) \
+	(Tcl_InitStubs)(interp, TCL_PATCH_LEVEL, \
+	    1|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
+	    TCL_STUB_MAGIC)
+# endif
 #else
 #   define Tcl_InitStubs(interp, version, exact) \
 	Tcl_PkgInitStubsCheck(interp, version, \
diff --git a/generic/tclIO.c b/generic/tclIO.c
index dbdbda5..3f7fe86 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -165,6 +165,7 @@ static int		CheckForDeadChannel(Tcl_Interp *interp,
 static void		CheckForStdChannelsBeingClosed(Tcl_Channel chan);
 static void		CleanupChannelHandlers(Tcl_Interp *interp,
 			    Channel *chanPtr);
+static void		CleanupTimerHandler(ChannelState *statePtr);
 static int		CloseChannel(Tcl_Interp *interp, Channel *chanPtr,
 			    int errorCode);
 static int		CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr,
@@ -172,6 +173,7 @@ static int		CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr,
 static int		CloseWrite(Tcl_Interp *interp, Channel *chanPtr);
 static void		CommonGetsCleanup(Channel *chanPtr);
 static int		CopyData(CopyState *csPtr, int mask);
+static void		DeleteTimerHandler(ChannelState *statePtr);
 static int		MoveBytes(CopyState *csPtr);
 
 static void		MBCallback(CopyState *csPtr, Tcl_Obj *errObj);
@@ -1734,6 +1736,7 @@ Tcl_CreateChannel(
     statePtr->scriptRecordPtr	= NULL;
     statePtr->bufSize		= CHANNELBUFFER_DEFAULT_SIZE;
     statePtr->timer		= NULL;
+    statePtr->timerChanPtr	= NULL;
     statePtr->csPtrR		= NULL;
     statePtr->csPtrW		= NULL;
     statePtr->outputStage	= NULL;
@@ -3191,8 +3194,8 @@ CloseChannel(
     /*
      * Cancel any outstanding timer.
      */
+    DeleteTimerHandler(statePtr);
 
-    Tcl_DeleteTimerHandler(statePtr->timer);
 
     /*
      * Mark the channel as deleted by clearing the type structure.
@@ -3544,7 +3547,7 @@ Tcl_Close(
     /*
      * Cancel any outstanding timer.
      */
-    Tcl_DeleteTimerHandler(statePtr->timer);
+    DeleteTimerHandler(statePtr);
 
     /*
      * Invoke the registered close callbacks and delete their records.
@@ -4019,8 +4022,7 @@ Tcl_ClearChannelHandlers(
     /*
      * Cancel any outstanding timer.
      */
-
-    Tcl_DeleteTimerHandler(statePtr->timer);
+    DeleteTimerHandler(statePtr);
 
     /*
      * Remove any references to channel handlers for this channel that may be
@@ -8715,8 +8717,9 @@ UpdateInterest(
 
 	    if (!statePtr->timer) {
 		TclChannelPreserve((Tcl_Channel)chanPtr);
+		statePtr->timerChanPtr = chanPtr;
 		statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
-                        ChannelTimerProc, chanPtr);
+		    ChannelTimerProc, chanPtr);
 	    }
 	}
     }
@@ -8726,6 +8729,7 @@ UpdateInterest(
 	&& GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
 
 	TclChannelPreserve((Tcl_Channel)chanPtr);
+	statePtr->timerChanPtr = chanPtr;
 	statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
 	    ChannelTimerProc,chanPtr);
     }
@@ -8756,7 +8760,6 @@ ChannelTimerProc(
     void *clientData)
 {
     Channel *chanPtr = (Channel *)clientData;
-
     /* State info for channel */
     ChannelState *statePtr = chanPtr->state;
 
@@ -8767,7 +8770,7 @@ ChannelTimerProc(
      */
 
     if (chanPtr->typePtr == NULL) {
-	TclChannelRelease((Tcl_Channel)chanPtr);
+	CleanupTimerHandler(statePtr);
     } else {
 	Tcl_Preserve(statePtr);
 	statePtr->timer = NULL;
@@ -8780,35 +8783,52 @@ ChannelTimerProc(
 	     * before UpdateInterest gets called by Tcl_NotifyChannel.
 	     */
 	    statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
-		    ChannelTimerProc,chanPtr);
+		ChannelTimerProc,chanPtr);
 	    Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_WRITABLE);
 	} else {
 	    /* The channel may have just been closed from within Tcl_NotifyChannel */
 	    if (!GotFlag(statePtr, CHANNEL_INCLOSE)) {
 		if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
-			&& (statePtr->interestMask & TCL_READABLE)
-			&& (statePtr->inQueueHead != NULL)
-			&& IsBufferReady(statePtr->inQueueHead)) {
+		    && (statePtr->interestMask & TCL_READABLE)
+		    && (statePtr->inQueueHead != NULL)
+		    && IsBufferReady(statePtr->inQueueHead)) {
 		    /*
 		     * Restart the timer in case a channel handler reenters the event loop
 		     * before UpdateInterest gets called by Tcl_NotifyChannel.
 		     */
 
 		    statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
-			    ChannelTimerProc,chanPtr);
+			ChannelTimerProc,chanPtr);
 		    Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
 		} else {
-		    TclChannelRelease((Tcl_Channel)chanPtr);
+		    CleanupTimerHandler(statePtr);
 		    UpdateInterest(chanPtr);
 		}
 	    } else {
-		TclChannelRelease((Tcl_Channel)chanPtr);
+		CleanupTimerHandler(statePtr);
 	    }
 	}
-
 	Tcl_Release(statePtr);
     }
-
+}
+
+static void
+DeleteTimerHandler(
+    ChannelState *statePtr
+)
+{
+    if (statePtr->timer != NULL) {
+	Tcl_DeleteTimerHandler(statePtr->timer);
+	CleanupTimerHandler(statePtr);
+    }
+}
+static void
+CleanupTimerHandler(
+    ChannelState *statePtr
+){
+    TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr);
+    statePtr->timer = NULL;
+    statePtr->timerChanPtr = NULL;
 }
 
 /*
diff --git a/generic/tclIO.h b/generic/tclIO.h
index 2500fa3..109c770 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -188,6 +188,9 @@ typedef struct ChannelState {
 				 * handlers ("fileevent") on this channel. */
     Tcl_Size bufSize;		/* What size buffers to allocate? */
     Tcl_TimerToken timer;	/* Handle to wakeup timer for this channel. */
+    Channel *timerChanPtr;	/* Needed in order to decrement the refCount of
+				   the right channel when the timer is
+				   deleted. */
     struct CopyState *csPtrR;	/* State of background copy for which channel
 				 * is input, or NULL. */
     struct CopyState *csPtrW;	/* State of background copy for which channel
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 522e6f8..f68029a 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -2122,7 +2122,7 @@ static int UtfExtWrapper(
     /* Assumes state is integer if not "" */
     Tcl_WideInt wide;
     if (Tcl_GetWideIntFromObj(interp, objv[5], &wide) == TCL_OK) {
-        encState = (Tcl_EncodingState) wide;
+        encState = (Tcl_EncodingState)(size_t)wide;
         encStatePtr = &encState;
     } else if (Tcl_GetCharLength(objv[5]) == 0) {
         encStatePtr = NULL;
@@ -2210,7 +2210,7 @@ static int UtfExtWrapper(
         }
         result = TCL_OK;
         resultObjs[1] =
-            encStatePtr ? Tcl_NewWideIntObj((Tcl_WideInt)encState) : Tcl_NewObj();
+            encStatePtr ? Tcl_NewWideIntObj((Tcl_WideInt)(size_t)encState) : Tcl_NewObj();
         resultObjs[2] = Tcl_NewByteArrayObj(bufPtr, dstLen);
         if (srcReadVar) {
 	    if (Tcl_ObjSetVar2(interp,
diff --git a/tests/encoding.test b/tests/encoding.test
index 31f966c..eb91a1d 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -1087,9 +1087,7 @@ test encoding-bug-183a1adcc0-4 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExtern
 } -result [list 0 [list nospace {} \x00\x00\xff]]
 
 test encoding-bug-183a1adcc0-5 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
-    testencoding
-} -constraints {
-    knownBug
+    testencoding ucs2 knownBug
 } -body {
     # The knownBug constraint is because test depends on TCL_UTF_MAX and
     # also UtfToUtf16 assumes space required in destination buffer is
diff --git a/tools/valgrind_check_success b/tools/valgrind_check_success
new file mode 100644
index 0000000..24830d5
--- /dev/null
+++ b/tools/valgrind_check_success
@@ -0,0 +1,30 @@
+#! /usr/bin/env tclsh
+
+
+proc main {sourcetype source} {
+	switch $sourcetype {
+		file {
+			set chan [open $source]
+			try {
+				set data [read $chan]
+			} finally {
+				close $chan
+			}
+		}
+		string {
+			set data $source
+		}
+		default {
+			error [list {wrong # args}]
+		}
+	}
+	set found [regexp -inline -all {blocks are\
+	    (?:(?:(?:definitely|indirectly|possibly) lost)|still reachable)} $data]
+	if {[llength $found]} {
+		puts 0
+	} else {
+		puts 1
+	}
+	flush stdout
+}
+main {*}$argv
diff --git a/unix/Makefile.in b/unix/Makefile.in
index da057d8..e092a2d 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -956,7 +956,8 @@ testresults/valgrind/%.result: ${TCL_EXE} ${TCLTEST_EXE}
 	@mkdir -p testresults/valgrind
 	$(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCLTEST_EXE} \
 		$(TOP_DIR)/tests/all.tcl -singleproc 1 -constraints valgrind \
-		-file $(basename $(notdir $@)) > $@ 2>&1
+		-file $(basename $(notdir $@)) > $@.tmp 2>&1
+	@mv $@.tmp $@
 .PRECIOUS: testresults/valgrind/%.result
 
 
@@ -966,7 +967,7 @@ testresults/valgrind/%.success: testresults/valgrind/%.result
 	@printf '\n >&2'
 	@status=$$(./${TCLTEST_EXE} $(TOP_DIR)/tools/valgrind_check_success \
 		file $(basename $@).result); \
-	if [ "$$status" -eq 1 ]; then exit 0; else exit 1; fi
+	if [ "$$status" -eq 1 ]; then touch $@; exit 0; else exit 1; fi
 
 valgrind_each: $(addprefix testresults/valgrind/,$(addsuffix .success,$(notdir\
 	$(wildcard $(TOP_DIR)/tests/*.test))))
diff --git a/unix/configure b/unix/configure
index c57ee40..be09ad6 100755
--- a/unix/configure
+++ b/unix/configure
@@ -7631,56 +7631,6 @@ printf "%s\n" "#define _LARGEFILE64_SOURCE 1" >>confdefs.h
 	tcl_flags="$tcl_flags _LARGEFILE64_SOURCE"
     fi
 
-
-    if test ${tcl_cv_flag__largefile_source64+y}
-then :
-  printf %s "(cached) " >&6
-else $as_nop
-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h.  */
-#include <sys/stat.h>
-int
-main (void)
-{
-char *p = (char *)open64;
-  ;
-  return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"
-then :
-  tcl_cv_flag__largefile_source64=no
-else $as_nop
-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h.  */
-#define _LARGEFILE_SOURCE64 1
-#include <sys/stat.h>
-int
-main (void)
-{
-char *p = (char *)open64;
-  ;
-  return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"
-then :
-  tcl_cv_flag__largefile_source64=yes
-else $as_nop
-  tcl_cv_flag__largefile_source64=no
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
-fi
-
-    if test "x${tcl_cv_flag__largefile_source64}" = "xyes" ; then
-
-printf "%s\n" "#define _LARGEFILE_SOURCE64 1" >>confdefs.h
-
-	tcl_flags="$tcl_flags _LARGEFILE_SOURCE64"
-    fi
-
     if test "x${tcl_flags}" = "x" ; then
 	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none" >&5
 printf "%s\n" "none" >&6; }
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index b85bcdf..bed1c75 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -2329,7 +2329,6 @@ AC_DEFUN([SC_TCL_LINK_LIBS], [
 #	Might define the following vars:
 #		_ISOC99_SOURCE
 #		_LARGEFILE64_SOURCE
-#		_LARGEFILE_SOURCE64
 #
 #--------------------------------------------------------------------
 
@@ -2353,8 +2352,6 @@ AC_DEFUN([SC_TCL_EARLY_FLAGS],[
 	[char *p = (char *)strtoll; char *q = (char *)strtoull;])
     SC_TCL_EARLY_FLAG(_LARGEFILE64_SOURCE,[#include <sys/stat.h>],
 	[struct stat64 buf; int i = stat64("/", &buf);])
-    SC_TCL_EARLY_FLAG(_LARGEFILE_SOURCE64,[#include <sys/stat.h>],
-	[char *p = (char *)open64;])
     if test "x${tcl_flags}" = "x" ; then
 	AC_MSG_RESULT([none])
     else
diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in
index 1396b69..f5c0e8b 100644
--- a/unix/tclConfig.h.in
+++ b/unix/tclConfig.h.in
@@ -492,9 +492,6 @@
 /* Add the _LARGEFILE64_SOURCE flag when building */
 #undef _LARGEFILE64_SOURCE
 
-/* Add the _LARGEFILE_SOURCE64 flag when building */
-#undef _LARGEFILE_SOURCE64
-
 /* # needed in sys/socket.h Should OS/390 do the right thing with sockets? */
 #undef _OE_SOCKETS