From f7b4c00c2817d11f545b2bbf7ee60e6567ab169c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 18 Apr 2024 15:32:16 +0000 Subject: Fix [18f4a94d03] by backing out [9bcec7cd880540c3] (again) --- generic/tclIO.c | 87 ++++++++++++---------------------------------------- generic/tclIORChan.c | 66 ++++----------------------------------- tests/ioCmd.test | 40 ++---------------------- 3 files changed, 27 insertions(+), 166 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 0d8d4db..92b8b62 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -167,7 +167,6 @@ 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, @@ -3194,8 +3193,8 @@ CloseChannel( /* * Cancel any outstanding timer. */ - DeleteTimerHandler(statePtr); + DeleteTimerHandler(statePtr); /* * Mark the channel as deleted by clearing the type structure. @@ -3545,11 +3544,6 @@ Tcl_Close( Tcl_ClearChannelHandlers(chan); /* - * Cancel any outstanding timer. - */ - DeleteTimerHandler(statePtr); - - /* * Invoke the registered close callbacks and delete their records. */ @@ -7626,7 +7620,6 @@ Tcl_Eof( return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0; } - /* *---------------------------------------------------------------------- * @@ -7652,7 +7645,7 @@ TclChannelGetBlockingMode( return GotFlag(statePtr, CHANNEL_NONBLOCKING) ? 0 : 1; } - + /* *---------------------------------------------------------------------- * @@ -8760,7 +8753,6 @@ UpdateInterest( { ChannelState *statePtr = chanPtr->state; /* State info for channel */ - ChannelBuffer *bufPtr = statePtr->outQueueHead; int mask = statePtr->interestMask; if (chanPtr->typePtr == NULL) { @@ -8838,20 +8830,6 @@ UpdateInterest( } } } - - if (!statePtr->timer - && (mask & TCL_WRITABLE) - && GotFlag(statePtr, CHANNEL_NONBLOCKING) - && bufPtr - && !IsBufferEmpty(bufPtr) - && !IsBufferFull(bufPtr) - ) { - TclChannelPreserve((Tcl_Channel)chanPtr); - statePtr->timerChanPtr = chanPtr; - statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ChannelTimerProc,chanPtr); - } - ChanWatch(chanPtr, mask); } @@ -8880,51 +8858,30 @@ ChannelTimerProc( /* State info for channel */ ChannelState *statePtr = chanPtr->state; - /* TclChannelPreserve() must be called before the current function was - * scheduled, is already in effect. In this function it guards against - * deallocation in Tcl_NotifyChannel and also keps the channel preserved - * until ChannelTimerProc is later called again. - */ - if (chanPtr->typePtr == NULL) { - CleanupTimerHandler(statePtr); - } else { - Tcl_Preserve(statePtr); statePtr->timer = NULL; - if (statePtr->interestMask & TCL_WRITABLE - && GotFlag(statePtr, CHANNEL_NONBLOCKING) - && !GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { + TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); + statePtr->timerChanPtr = NULL; + } else { + if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA) + && (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); - Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_WRITABLE); + Tcl_Preserve(statePtr); + Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE); + Tcl_Release(statePtr); } 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)) { - /* - * 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); - Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE); - } else { - CleanupTimerHandler(statePtr); - UpdateInterest(chanPtr); - } - } else { - CleanupTimerHandler(statePtr); - } + statePtr->timer = NULL; + UpdateInterest(chanPtr); + TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); + statePtr->timerChanPtr = NULL; } - Tcl_Release(statePtr); } } @@ -8935,17 +8892,11 @@ DeleteTimerHandler( { if (statePtr->timer != NULL) { Tcl_DeleteTimerHandler(statePtr->timer); - CleanupTimerHandler(statePtr); + statePtr->timer = NULL; + TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); + statePtr->timerChanPtr = NULL; } } -static void -CleanupTimerHandler( - ChannelState *statePtr -){ - TclChannelRelease((Tcl_Channel)statePtr->timerChanPtr); - statePtr->timer = NULL; - statePtr->timerChanPtr = NULL; -} /* *---------------------------------------------------------------------- diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 4e938ae..d284f15 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -58,8 +58,6 @@ static int ReflectSetOption(void *clientData, const char *newValue); static int ReflectTruncate(void *clientData, long long length); -static void TimerRunRead(void *clientData); -static void TimerRunWrite(void *clientData); /* * The C layer channel type/driver definition used by the reflection. @@ -121,17 +119,6 @@ typedef struct { int dead; /* Boolean signal that some operations * should no longer be attempted. */ - Tcl_TimerToken readTimer; /* - A token for the timer that is scheduled in - order to call Tcl_NotifyChannel when the - channel is readable - */ - Tcl_TimerToken writeTimer; /* - A token for the timer that is scheduled in - order to call Tcl_NotifyChannel when the - channel is writable - */ - /* * Note regarding the usage of timers. * @@ -141,9 +128,11 @@ typedef struct { * * See 'refchan', 'memchan', etc. * - * A timer is used here as well in order to ensure at least on pass through - * the event loop when a channel becomes ready. See issues 67a5eabbd3d1 and - * ef28eb1f1516. + * Here this is _not_ required. Interest in events is posted to the Tcl + * level via 'watch'. And posting of events is possible from the Tcl level + * as well, via 'chan postevent'. This means that the generation of all + * events, fake or not, timer based or not, is completely in the hands of + * the Tcl level. Therefore no timer here. */ } ReflectedChannel; @@ -959,18 +948,7 @@ TclChanPostEventObjCmd( #if TCL_THREADS if (rcPtr->owner == rcPtr->thread) { #endif - if (events & TCL_READABLE) { - if (rcPtr->readTimer == NULL) { - rcPtr->readTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - TimerRunRead, rcPtr); - } - } - if (events & TCL_WRITABLE) { - if (rcPtr->writeTimer == NULL) { - rcPtr->writeTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - TimerRunWrite, rcPtr); - } - } + Tcl_NotifyChannel(chan, events); #if TCL_THREADS } else { ReflectEvent *ev = (ReflectEvent *)ckalloc(sizeof(ReflectEvent)); @@ -1018,24 +996,6 @@ TclChanPostEventObjCmd( #undef EVENT } -static void -TimerRunRead( - void *clientData) -{ - ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; - rcPtr->readTimer = NULL; - Tcl_NotifyChannel(rcPtr->chan, TCL_READABLE); -} - -static void -TimerRunWrite( - void *clientData) -{ - ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; - rcPtr->writeTimer = NULL; - Tcl_NotifyChannel(rcPtr->chan, TCL_WRITABLE); -} - /* * Channel error message marshalling utilities. */ @@ -1234,12 +1194,6 @@ ReflectClose( ckfree(tctPtr); ((Channel *)rcPtr->chan)->typePtr = NULL; } - if (rcPtr->readTimer != NULL) { - Tcl_DeleteTimerHandler(rcPtr->readTimer); - } - if (rcPtr->writeTimer != NULL) { - Tcl_DeleteTimerHandler(rcPtr->writeTimer); - } Tcl_EventuallyFree(rcPtr, FreeReflectedChannel); return EOK; } @@ -1309,12 +1263,6 @@ ReflectClose( ckfree(tctPtr); ((Channel *)rcPtr->chan)->typePtr = NULL; } - if (rcPtr->readTimer != NULL) { - Tcl_DeleteTimerHandler(rcPtr->readTimer); - } - if (rcPtr->writeTimer != NULL) { - Tcl_DeleteTimerHandler(rcPtr->writeTimer); - } Tcl_EventuallyFree(rcPtr, FreeReflectedChannel); return (result == TCL_OK) ? EOK : EINVAL; } @@ -2280,8 +2228,6 @@ NewReflectedChannel( rcPtr->chan = NULL; rcPtr->interp = interp; rcPtr->dead = 0; - rcPtr->readTimer = 0; - rcPtr->writeTimer = 0; #if TCL_THREADS rcPtr->thread = Tcl_GetCurrentThread(); #endif diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 91e53fe..4400c56 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -985,17 +985,6 @@ proc onfinal {} { if {[lindex $hargs 0] ne "finalize"} {return} return -code return "" } - -proc onwatch {} { - upvar args hargs - lassign $hargs watch chan eventspec - if {$watch ne "watch"} return - foreach spec $eventspec { - chan postevent $chan $spec - } - return -} - } # Set everything up in the main thread. @@ -2077,7 +2066,7 @@ test iocmd-31.6 {chan postevent, posted events do happen} -match glob -body { close $c rename foo {} set res -} -result {{watch rc* read} {} {} TOCK {watch rc* {}}} +} -result {{watch rc* read} {} TOCK {} {watch rc* {}}} test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return} @@ -2090,7 +2079,7 @@ test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body { close $c rename foo {} set res -} -result {{watch rc* write} {} {} TOCK {watch rc* {}}} +} -result {{watch rc* write} {} TOCK {} {watch rc* {}}} test iocmd-31.8 {chan postevent after close throws error} -match glob -setup { proc foo {args} {oninit; onfinal; track; return} proc dummy args { return } @@ -2103,31 +2092,6 @@ test iocmd-31.8 {chan postevent after close throws error} -match glob -setup { rename foo {} rename dummy {} } -returnCodes error -result {can not find reflected channel named "rc*"} -test iocmd-31.9 { - chan postevent - - call to current coroutine - - see 67a5eabbd3d1 -} -match glob -body { - set res {} - proc foo {args} {oninit; onwatch; onfinal; track; return} - set c [chan create {r w} foo] - after 0 [list ::apply [list c { - coroutine c1 ::apply [list c { - chan event $c readable [list [info coroutine]] - yield - set ::done READING - } [namespace current]] $c - } [namespace current]] $c] - set stop [after 10000 {set done TIMEOUT}] - vwait ::done - catch {after cancel $stop} - lappend res $done - close $c - rename foo {} - set res -} -result {{watch rc* read} READING {watch rc* {}}} # --- === *** ########################### # 'Pull the rug' tests. Create channel in a interpreter A, move to -- cgit v0.12 From a6ab10a182d00fa11a958b7ba22a319822973444 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Fri, 24 May 2024 16:22:18 +0000 Subject: Tests for bug fixes --- tests/io.test | 79 ++++++++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 73 insertions(+), 6 deletions(-) diff --git a/tests/io.test b/tests/io.test index 49c16b7..a41e56b 100644 --- a/tests/io.test +++ b/tests/io.test @@ -6253,21 +6253,27 @@ test io-44.5 {FileEventProc procedure: end of file} -constraints { close $f +# Bug https://core.tcl-lang.org/tcl/info/de232b49f26da1c1 with a corrected +# refchan implementation. refchans should be responsible for their own +# event generation and the one in the bug report was not doing so. test io-44.6 {FileEventProc procedure: write-only non-blocking channel} -setup { -} -constraints {stdio fileevent openpipe} -body { +} -constraints {stdio fileevent} -body { namespace eval refchan { namespace ensemble create namespace export * - + # Change to taste depending on how much CPU you want to hog + variable delay 0 proc finalize {chan args} { + namespace upvar c_$chan timer timer + catch {after cancel $timer} namespace delete c_$chan } proc initialize {chan args} { namespace eval c_$chan {} - namespace upvar c_$chan watching watching + namespace upvar c_$chan watching watching timer timer set watching {} list finalize initialize seek watch write } @@ -6281,17 +6287,37 @@ test io-44.6 {FileEventProc procedure: write-only non-blocking channel} -setup { if {$arg ni $watching} { lappend watching $arg } - chan postevent $chan $arg } } } + update $chan } - proc write {chan args} { - chan postevent $chan write return 1 } + + # paraphrased from tcllib + proc update {chan} { + namespace upvar c_$chan watching watching timer timer + variable delay + catch {after cancel $timer} + if {"write" in $watching} { + set timer [after idle after $delay \ + [namespace code [list post $chan]]] + } + } + + # paraphrased from tcllib + proc post {chan} { + variable delay + namespace upvar c_$chan watching watching timer timer + if {"write" in $watching} { + set timer [after idle after $delay \ + [namespace code [list post $chan]]] + chan postevent $chan write + } + } } set f [chan create w [namespace which refchan]] chan configure $f -blocking 0 @@ -6315,6 +6341,47 @@ test io-44.6 {FileEventProc procedure: write-only non-blocking channel} -setup { catch {chan close $f} } -result done +# Bug https://core.tcl-lang.org/tcl/info/67a5eabbd3d1 with a corrected +# refchan implementation. refchans that are not reentrant should use +# event loop to post events and the script in the bug report was not +# doing so. +test io-44.7 {refchan + coroutine yield error } -setup { + set bghandler [interp bgerror {}] + namespace eval schan { + namespace ensemble create + namespace export * + proc open {} { + set chan [chan create read [namespace current]] + + } + proc initialize {chan mode} { + return [list initialize finalize read watch] + } + + proc read {chan count} { + } + + proc watch {chan eventspec} { + after idle after 0 chan postevent $chan $eventspec + } + } +} -cleanup { + interp bgerror {} $bghandler + unset -nocomplain ::io-44.7-result + namespace delete schan +} -body { + interp bgerror {} [list apply {{res opts} { + set ::io-44.7-result [dict get $opts -errorinfo] + }}] + coroutine c1 apply [list {} { + set chan [schan::open] + chan event $chan readable [list [info coroutine]] + yield + set ::io-44.7-result success + } [namespace current]] + vwait ::io-44.7-result + set ::io-44.7-result +} -result success makeFile "foo bar" foo -- cgit v0.12 From 0287c421a00eaa857c07d1f947d64a33550693e9 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Tue, 28 May 2024 11:32:39 +0000 Subject: Fix tests - need longer timer under valgrind. Close created channels. --- tests/io.test | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/tests/io.test b/tests/io.test index a41e56b..ad8d6b7 100644 --- a/tests/io.test +++ b/tests/io.test @@ -6331,7 +6331,8 @@ test io-44.6 {FileEventProc procedure: write-only non-blocking channel} -setup { set x done } }] - set token [after 10000 [namespace code { + # Note: timeout needs to be very long under valgrind + set token [after 240000 [namespace code { set x timeout }]] vwait [namespace which -variable x] @@ -6357,12 +6358,12 @@ test io-44.7 {refchan + coroutine yield error } -setup { proc initialize {chan mode} { return [list initialize finalize read watch] } - - proc read {chan count} { - } - + proc finalize args {} + proc read {chan count} {} proc watch {chan eventspec} { - after idle after 0 chan postevent $chan $eventspec + foreach event $eventspec { + after idle after 0 chan postevent $chan $event + } } } } -cleanup { @@ -6377,6 +6378,7 @@ test io-44.7 {refchan + coroutine yield error } -setup { set chan [schan::open] chan event $chan readable [list [info coroutine]] yield + close $chan set ::io-44.7-result success } [namespace current]] vwait ::io-44.7-result -- cgit v0.12