diff options
| -rw-r--r-- | ChangeLog | 14 | ||||
| -rw-r--r-- | generic/tclIO.c | 30 | ||||
| -rw-r--r-- | generic/tclIORTrans.c | 56 | ||||
| -rw-r--r-- | tests/ioTrans.test | 93 |
4 files changed, 170 insertions, 23 deletions
@@ -1,3 +1,17 @@ +2010-03-17 Andreas Kupries <andreask@activestate.com> + + * generic/tclIORTrans.c (ReflectInput, ReflectOutput, + ReflectSeekWide): [Bug 2921116]: Added missing TclEventuallyFree + calls for preserved ReflectedTransform* structures. Reworked + ReflectInput to preserve the structure for its whole life, not + only in InvokeTclMethod. + + * generic/tclIO.c (Tcl_GetsObj): [Bug 2921116]: Regenerate + topChan, may have been changed by a self-modifying transformation. + + * tests/ioTrans/test (iortrans-4.8, iortrans-4.9, iortrans-5.11, + iortrans-7.4, iortrans-8.3): New test cases. + 2010-03-16 Jan Nijtmans <nijtmans@users.sf.net> * compat/zlib/* Upgrade zlib to version 1.2.4 diff --git a/generic/tclIO.c b/generic/tclIO.c index 7ed714c..bc94bb6 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIO.c,v 1.172 2010/02/24 10:45:04 dkf Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.173 2010/03/17 16:35:42 andreas_kupries Exp $ */ #include "tclInt.h" @@ -4715,6 +4715,13 @@ Tcl_GetsObj( */ gotEOL: + /* + * Regenerate the top channel, in case it was changed due to + * self-modifying reflected transforms. + */ + + chanPtr = statePtr->topChanPtr; + bufPtr = gs.bufPtr; if (bufPtr == NULL) { Tcl_Panic("Tcl_GetsObj: gotEOL reached with bufPtr==NULL"); @@ -4743,6 +4750,13 @@ Tcl_GetsObj( */ restore: + /* + * Regenerate the top channel, in case it was changed due to + * self-modifying reflected transforms. + */ + + chanPtr = statePtr->topChanPtr; + bufPtr = statePtr->inQueueHead; if (bufPtr == NULL) { Tcl_Panic("Tcl_GetsObj: restore reached with bufPtr==NULL"); @@ -4778,6 +4792,13 @@ Tcl_GetsObj( */ done: + /* + * Regenerate the top channel, in case it was changed due to + * self-modifying reflected transforms. + */ + + chanPtr = statePtr->topChanPtr; + UpdateInterest(chanPtr); return copiedTotal; } @@ -5776,6 +5797,13 @@ DoReadChars( */ done: + /* + * Regenerate the top channel, in case it was changed due to + * self-modifying reflected transforms. + */ + + chanPtr = statePtr->topChanPtr; + UpdateInterest(chanPtr); return copied; } diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index eb40ce5..801f5fb 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIORTrans.c,v 1.14 2010/03/05 22:50:32 dkf Exp $ + * RCS: @(#) $Id: tclIORTrans.c,v 1.15 2010/03/17 16:35:42 andreas_kupries Exp $ */ #include <tclInt.h> @@ -721,7 +721,7 @@ TclChanPushObjCmd( * structure. */ - FreeReflectedTransform(rtPtr); + Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform); return TCL_ERROR; #undef CHAN @@ -931,7 +931,7 @@ ReflectClose( } #endif - FreeReflectedTransform(rtPtr); + Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform); return EOK; } @@ -1030,7 +1030,7 @@ ReflectClose( } #endif - FreeReflectedTransform(rtPtr); + Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform); return (result == TCL_OK) ? EOK : EINVAL; } @@ -1072,8 +1072,9 @@ ReflectInput( return -1; } - gotBytes = 0; + Tcl_Preserve(rtPtr); + gotBytes = 0; while (toRead > 0) { /* * Loop until the request is satisfied (or no data available from @@ -1086,7 +1087,7 @@ ReflectInput( gotBytes += copied; if (toRead == 0) { - return gotBytes; + goto stop; } /* @@ -1109,10 +1110,10 @@ ReflectInput( int maxRead = -1; if (!TransformLimit(rtPtr, errorCodePtr, &maxRead)) { - return -1; + goto error; } if (maxRead == 0) { - return gotBytes; + goto stop; } else if (maxRead > 0) { if (maxRead < toRead) { toRead = maxRead; @@ -1121,7 +1122,7 @@ ReflectInput( } if (toRead <= 0) { - return gotBytes; + goto stop; } readBytes = Tcl_ReadRaw(rtPtr->parent, buf, toRead); @@ -1137,11 +1138,11 @@ ReflectInput( * we report that instead of the request to re-try. */ - return gotBytes; + goto stop; } *errorCodePtr = Tcl_GetErrno(); - return -1; + goto error; } if (readBytes == 0) { @@ -1162,16 +1163,16 @@ ReflectInput( if ((gotBytes == 0) && rtPtr->nonblocking) { *errorCodePtr = EWOULDBLOCK; - return -1; + goto error; } - return gotBytes; + goto stop; } else { /* * Eof in parent. */ if (rtPtr->readIsDrained) { - return gotBytes; + goto stop; } /* @@ -1181,7 +1182,7 @@ ReflectInput( if (HAS(rtPtr->methods, METH_DRAIN)) { if (!TransformDrain(rtPtr, errorCodePtr)) { - return -1; + goto error; } } @@ -1190,7 +1191,7 @@ ReflectInput( * The drain delivered nothing. */ - return gotBytes; + goto stop; } /* @@ -1209,11 +1210,17 @@ ReflectInput( */ if (!TransformRead(rtPtr, errorCodePtr, UCHARP(buf), readBytes)) { - return -1; + goto error; } } /* while toRead > 0 */ + stop: + Tcl_Release(rtPtr); return gotBytes; + + error: + gotBytes = -1; + goto stop; } /* @@ -1266,6 +1273,8 @@ ReflectOutput( * we do when explicitly seeking as well. */ + Tcl_Preserve(rtPtr); + if ((rtPtr->methods & FLAG(METH_CLEAR))) { TransformClear(rtPtr); } @@ -1277,10 +1286,12 @@ ReflectOutput( */ if (!TransformWrite(rtPtr, errorCodePtr, UCHARP(buf), toWrite)) { + Tcl_Release(rtPtr); return -1; } *errorCodePtr = EOK; + Tcl_Release(rtPtr); return toWrite; } @@ -1331,6 +1342,8 @@ ReflectSeekWide( * request down and the result back up unchanged. */ + Tcl_Preserve(rtPtr); + if (((seekMode != SEEK_CUR) || (offset != 0)) && (HAS(rtPtr->methods, METH_CLEAR) || HAS(rtPtr->methods, METH_FLUSH))) { @@ -1353,6 +1366,7 @@ ReflectSeekWide( if (HAS(rtPtr->methods, METH_FLUSH)) { if (!TransformFlush(rtPtr, errorCodePtr, FLUSH_DISCARD)) { + Tcl_Release(rtPtr); return -1; } } @@ -1382,6 +1396,7 @@ ReflectSeekWide( } *errorCodePtr = EOK; + Tcl_Release(rtPtr); return curPos; } @@ -1971,7 +1986,7 @@ InvokeTclMethod( */ sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */); - Tcl_Preserve(rtPtr->interp); + Tcl_Preserve(rtPtr); result = Tcl_EvalObjv(rtPtr->interp, cmdc, rtPtr->argv, TCL_EVAL_GLOBAL); /* @@ -2016,7 +2031,7 @@ InvokeTclMethod( Tcl_IncrRefCount(resObj); } Tcl_RestoreInterpState(rtPtr->interp, sr); - Tcl_Release(rtPtr->interp); + Tcl_Release(rtPtr); /* * Cleanup of the dynamic parts of the command. @@ -2531,7 +2546,8 @@ ForwardProc( rtmPtr = GetThreadReflectedTransformMap(); hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle)); Tcl_DeleteHashEntry(hPtr); - FreeReflectedTransform(rtPtr); + + Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform); break; case ForwardedInput: { diff --git a/tests/ioTrans.test b/tests/ioTrans.test index d26789c..7399bfb 100644 --- a/tests/ioTrans.test +++ b/tests/ioTrans.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: ioTrans.test,v 1.7 2008/07/21 21:12:49 ferrieux Exp $ +# RCS: @(#) $Id: ioTrans.test,v 1.8 2010/03/17 16:35:42 andreas_kupries Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -41,6 +41,7 @@ set helperscript { } proc note {item} {global res; lappend res $item; return} + #proc note {item} {global res; lappend res $item; puts $item ; flush stdout ; return} proc track {} {upvar args item; note $item; return} proc notes {items} {foreach i $items {note $i}} @@ -452,7 +453,41 @@ test iortrans-4.7 {chan read, level is squashed} -match glob -body { set res } -result {{read rt* {test data }} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}} - +test iortrans-4.8 {chan read, read, bug 2921116} -match glob -setup { + set res {} + proc foo {fd args} { + oninit; onfinal; track + # Kill and recreate transform while it is operating + chan pop $fd + chan push $fd [list foo $fd] + } + set c [chan push [set c [tempchan]] [list foo $c]] +} -body { + note [read $c] + #note [gets $c] + set res +} -cleanup { + tempdone + rename foo {} +} -result {{read rt* {test data +}} file*} +test iortrans-4.9 {chan read, gets, bug 2921116} -match glob -setup { + set res {} + proc foo {fd args} { + oninit; onfinal; track + # Kill and recreate transform while it is operating + chan pop $fd + chan push $fd [list foo $fd] + } + set c [chan push [set c [tempchan]] [list foo $c]] +} -body { + note [gets $c] + set res +} -cleanup { + tempdone + rename foo {} +} -result {{read rt* {test data +}} file*} # --- === *** ########################### # method write (via puts) @@ -560,6 +595,28 @@ test iortrans-5.10 {chan write, failed write, level is ignored} -match glob -bod rename foo {} set res } -result {{write rt* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "write"*}} +test iortrans-5.11 {chan write, bug 2921116} -match glob -setup { + set res {} + set level 0 + proc foo {fd args} { + oninit; onfinal; track + # pop - invokes flush - invokes 'foo write' - infinite recursion - stop it + global level + if {$level} { return "" } + incr level + # Kill and recreate transform while it is operating + chan pop $fd + chan push $fd [list foo $fd] + } + set c [chan push [set c [tempchan]] [list foo $c]] +} -body { + note [puts -nonewline $c abcdef] + note [flush $c] + set res +} -cleanup { + tempdone + rename foo {} +} -result {{} {write rt* abcdef} {write rt* abcdef} {}} # --- === *** ########################### # method limit?, drain (via read) @@ -631,6 +688,22 @@ test iortrans-7.3 {clear, any result is ignored} -match glob -body { rename foo {} set res } -result {{clear rt*}} +test iortrans-7.4 {chan clear, bug 2921116} -match glob -setup { + set res {} + proc foo {fd args} { + oninit clear; onfinal; track + # Kill and recreate transform while it is operating + chan pop $fd + chan push $fd [list foo $fd] + } + set c [chan push [set c [tempchan]] [list foo $c]] +} -body { + seek $c 2 + set res +} -cleanup { + tempdone + rename foo {} +} -result {{clear rt*}} # --- === *** ########################### # method flush (via seek, close) @@ -666,6 +739,22 @@ test iortrans-8.2 {close flushes write buffers, writes data} -match glob -body { set res } -result {{flush rt*} {finalize rt*} .flushed.} +test iortrans-8.3 {chan flush, bug 2921116} -match glob -setup { + set res {} + proc foo {fd args} { + oninit flush; onfinal; track + # Kill and recreate transform while it is operating + chan pop $fd + chan push $fd [list foo $fd] + } + set c [chan push [set c [tempchan]] [list foo $c]] +} -body { + seek $c 2 + set res +} -cleanup { + tempdone + rename foo {} +} -result {{flush rt*}} # --- === *** ########################### # method watch - removed from TIP (rev 1.12+) |