diff options
-rw-r--r-- | generic/tcl.h | 7 | ||||
-rw-r--r-- | generic/tclIO.c | 52 | ||||
-rw-r--r-- | generic/tclIO.h | 3 | ||||
-rw-r--r-- | generic/tclTest.c | 4 | ||||
-rw-r--r-- | tests/encoding.test | 4 | ||||
-rw-r--r-- | tools/valgrind_check_success | 30 | ||||
-rw-r--r-- | unix/Makefile.in | 5 | ||||
-rwxr-xr-x | unix/configure | 50 | ||||
-rw-r--r-- | unix/tcl.m4 | 3 | ||||
-rw-r--r-- | unix/tclConfig.h.in | 3 |
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 |