From d22e96bfc585f1e3d9b592a0dfdeeabe1c6a49e2 Mon Sep 17 00:00:00 2001 From: andreas_kupries Date: Wed, 4 Aug 2010 16:49:02 +0000 Subject: * generic/tclIORChan.c: [Bug 3034840]: Fixed reference counting * generic/tclIORTrans.c: in InvokeTclMethod and callers. * tests/ioTrans.test: --- ChangeLog | 8 +++-- generic/tclIORChan.c | 98 +++++++++++++++++++++++++++++++++++++-------------- generic/tclIORTrans.c | 39 +++++++++++++++----- tests/ioTrans.test | 24 ++++++++++++- 4 files changed, 130 insertions(+), 39 deletions(-) diff --git a/ChangeLog b/ChangeLog index f2075c0..192f239 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,10 +1,14 @@ +2010-08-04 Andreas Kupries + + * generic/tclIORChan.c: [Bug 3034840]: Fixed reference counting + * generic/tclIORTrans.c: in InvokeTclMethod and callers. + * tests/ioTrans.test: + 2010-08-03 Andreas Kupries * tests/var.test (var-19.1): [Bug 3037525]: Added test demonstrating the local hashtable deletion crash and fix. -2010-08-03 Andreas Kupries - * tests/info.test (info-39.1): Added forward copy of test in 8.5 branch about [Bug 2933089]. Should not fail, and doesn't, after updating the line numbers to the changed position. diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 2f4716e..b8c248b 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.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: tclIORChan.c,v 1.49 2010/05/03 11:37:56 nijtmans Exp $ + * RCS: @(#) $Id: tclIORChan.c,v 1.50 2010/08/04 16:49:02 andreas_kupries Exp $ */ #include "tclInt.h" @@ -589,8 +589,10 @@ TclChanCreateObjCmd( */ modeObj = DecodeEventMask(mode); + /* assert modeObj.refCount == 1 */ result = InvokeTclMethod(rcPtr, "initialize", modeObj, NULL, &resObj); Tcl_DecrRefCount(modeObj); + if (result != TCL_OK) { UnmarshallErrorResult(interp, resObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ @@ -1245,6 +1247,8 @@ ReflectInput( Tcl_Preserve(rcPtr); toReadObj = Tcl_NewIntObj(toRead); + Tcl_IncrRefCount(toReadObj); + if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); @@ -1271,6 +1275,7 @@ ReflectInput( } stop: + Tcl_DecrRefCount(toReadObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_Release(rcPtr); return bytec; @@ -1357,6 +1362,8 @@ ReflectOutput( Tcl_Preserve(rcPtr); bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite); + Tcl_IncrRefCount(bufObj); + if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); @@ -1396,6 +1403,7 @@ ReflectOutput( *errorCodePtr = EOK; stop: + Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_Release(rcPtr); return written; @@ -1463,9 +1471,12 @@ ReflectSeekWide( Tcl_Preserve(rcPtr); - offObj = Tcl_NewWideIntObj(offset); + offObj = Tcl_NewWideIntObj(offset); baseObj = Tcl_NewStringObj((seekMode == SEEK_SET) ? "start" : ((seekMode == SEEK_CUR) ? "current" : "end"), -1); + Tcl_IncrRefCount(offObj); + Tcl_IncrRefCount(baseObj); + if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); goto invalid; @@ -1483,6 +1494,8 @@ ReflectSeekWide( *errorCodePtr = EOK; stop: + Tcl_DecrRefCount(offObj); + Tcl_DecrRefCount(baseObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_Release(rcPtr); return newLoc; @@ -1578,6 +1591,7 @@ ReflectWatch( Tcl_Preserve(rcPtr); maskObj = DecodeEventMask(mask); + /* assert maskObj.refCount == 1 */ (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL); Tcl_DecrRefCount(maskObj); @@ -1633,6 +1647,7 @@ ReflectBlock( #endif blockObj = Tcl_NewBooleanObj(!nonblocking); + Tcl_IncrRefCount(blockObj); Tcl_Preserve(rcPtr); @@ -1643,6 +1658,7 @@ ReflectBlock( errorNum = EOK; } + Tcl_DecrRefCount(blockObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_Release(rcPtr); @@ -1705,11 +1721,17 @@ ReflectSetOption( optionObj = Tcl_NewStringObj(optionName, -1); valueObj = Tcl_NewStringObj(newValue, -1); + + Tcl_IncrRefCount(optionObj); + Tcl_IncrRefCount(valueObj); + result = InvokeTclMethod(rcPtr, "configure",optionObj,valueObj, &resObj); if (result != TCL_OK) { UnmarshallErrorResult(interp, resObj); } + Tcl_DecrRefCount(optionObj); + Tcl_DecrRefCount(valueObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_Release(rcPtr); return result; @@ -1746,7 +1768,7 @@ ReflectGetOption( ReflectedChannel *rcPtr = clientData; Tcl_Obj *optionObj; Tcl_Obj *resObj; /* Result data for 'configure' */ - int listc; + int listc, result = TCL_OK; Tcl_Obj **listv; const char *method; @@ -1796,6 +1818,7 @@ ReflectGetOption( method = "cget"; optionObj = Tcl_NewStringObj(optionName, -1); + Tcl_IncrRefCount(optionObj); } Tcl_Preserve(rcPtr); @@ -1853,13 +1876,17 @@ ReflectGetOption( } ok: + result = TCL_OK; + stop: + if (optionObj) { + Tcl_DecrRefCount(optionObj); + } Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_Release(rcPtr); - return TCL_OK; + return result; error: - Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ - Tcl_Release(rcPtr); - return TCL_ERROR; + result = TCL_ERROR; + goto stop; } /* @@ -1939,7 +1966,7 @@ EncodeEventMask( * This function takes an internal bitmask of events and constructs the * equivalent list of event items. * - * Results: + * Results, Contract: * A Tcl_Obj reference. The object will have a refCount of one. The user * has to decrement it to release the object. * @@ -1973,6 +2000,7 @@ DecodeEventMask( evObj = Tcl_NewStringObj(eventStr, -1); Tcl_IncrRefCount(evObj); + /* assert evObj.refCount == 1 */ return evObj; } @@ -2157,6 +2185,11 @@ FreeReflectedChannel( * Side effects: * Arbitrary, as it calls upon a Tcl script. * + * Contract: + * argOneObj.refCount >= 1 on entry and exit, if argOneObj != NULL + * argTwoObj.refCount >= 1 on entry and exit, if argTwoObj != NULL + * resObj.refCount in {0, 1, ...} + * *---------------------------------------------------------------------- */ @@ -2186,16 +2219,10 @@ InvokeTclMethod( Tcl_IncrRefCount(resObj); } - /* - * Cleanup of the dynamic parts of the command. - */ - - if (argOneObj) { - Tcl_DecrRefCount(argOneObj); - if (argTwoObj) { - Tcl_DecrRefCount(argTwoObj); - } - } + /* + * Not touching argOneObj, argTwoObj, they have not been used. + * See the contract as well. + */ return TCL_ERROR; } @@ -2218,15 +2245,16 @@ InvokeTclMethod( /* * Append the additional argument containing method specific details * behind the channel id. If specified. + * + * Because of the contract there is no need to increment the refcounts. + * The objects will survive the Tcl_EvalObjv without change. */ cmdc = rcPtr->argc; if (argOneObj) { - Tcl_IncrRefCount(argOneObj); rcPtr->argv[cmdc] = argOneObj; cmdc++; if (argTwoObj) { - Tcl_IncrRefCount(argTwoObj); rcPtr->argv[cmdc] = argTwoObj; cmdc++; } @@ -2289,15 +2317,13 @@ InvokeTclMethod( /* * Cleanup of the dynamic parts of the command. + * + * The detail objects survived the Tcl_EvalObjv without change because of + * the contract. Therefore there is no need to decrement the refcounts. Only + * the internal method object has to be disposed of. */ Tcl_DecrRefCount(methObj); - if (argOneObj) { - Tcl_DecrRefCount(argOneObj); - if (argTwoObj) { - Tcl_DecrRefCount(argTwoObj); - } - } /* * The resObj has a ref count of 1 at this location. This means that the @@ -2855,6 +2881,7 @@ ForwardProc( case ForwardedInput: { Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead); + Tcl_IncrRefCount(toReadObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK){ @@ -2887,12 +2914,14 @@ ForwardProc( } } Tcl_Release(rcPtr); + Tcl_DecrRefCount(toReadObj); break; } case ForwardedOutput: { Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *) paramPtr->output.buf, paramPtr->output.toWrite); + Tcl_IncrRefCount(bufObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) { @@ -2922,6 +2951,7 @@ ForwardProc( } } Tcl_Release(rcPtr); + Tcl_DecrRefCount(bufObj); break; } @@ -2931,6 +2961,9 @@ ForwardProc( (paramPtr->seek.seekMode==SEEK_SET) ? "start" : (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1); + Tcl_IncrRefCount(offObj); + Tcl_IncrRefCount(baseObj); + Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); @@ -2956,11 +2989,14 @@ ForwardProc( } } Tcl_Release(rcPtr); + Tcl_DecrRefCount(offObj); + Tcl_DecrRefCount(baseObj); break; } case ForwardedWatch: { Tcl_Obj *maskObj = DecodeEventMask(paramPtr->watch.mask); + /* assert maskObj.refCount == 1 */ Tcl_Preserve(rcPtr); (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL); @@ -2971,6 +3007,7 @@ ForwardProc( case ForwardedBlock: { Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking); + Tcl_IncrRefCount(blockObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, @@ -2978,19 +3015,24 @@ ForwardProc( ForwardSetObjError(paramPtr, resObj); } Tcl_Release(rcPtr); + Tcl_DecrRefCount(blockObj); break; } case ForwardedSetOpt: { Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -1); - Tcl_Obj *valueObj = Tcl_NewStringObj(paramPtr->setOpt.value, -1); + Tcl_Obj *valueObj = Tcl_NewStringObj(paramPtr->setOpt.value, -1); + Tcl_IncrRefCount(optionObj); + Tcl_IncrRefCount(valueObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } Tcl_Release(rcPtr); + Tcl_DecrRefCount(optionObj); + Tcl_DecrRefCount(valueObj); break; } @@ -3000,6 +3042,7 @@ ForwardProc( */ Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1); + Tcl_IncrRefCount(optionObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){ @@ -3009,6 +3052,7 @@ ForwardProc( TclGetString(resObj), -1); } Tcl_Release(rcPtr); + Tcl_DecrRefCount(optionObj); break; } diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index ae1ffc0..54b73c0 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.17 2010/05/03 11:37:32 nijtmans Exp $ + * RCS: @(#) $Id: tclIORTrans.c,v 1.18 2010/08/04 16:49:02 andreas_kupries Exp $ */ #include "tclInt.h" @@ -587,6 +587,7 @@ TclChanPushObjCmd( */ modeObj = DecodeEventMask(mode); + /* assert modeObj.refCount == 1 */ result = InvokeTclMethod(rtPtr, "initialize", modeObj, NULL, &resObj); Tcl_DecrRefCount(modeObj); if (result != TCL_OK) { @@ -1913,6 +1914,11 @@ FreeReflectedTransform( * Side effects: * Arbitrary, as it calls upon a Tcl script. * + * Contract: + * argOneObj.refCount >= 1 on entry and exit, if argOneObj != NULL + * argTwoObj.refCount >= 1 on entry and exit, if argTwoObj != NULL + * resObj.refCount in {0, 1, ...} + * *---------------------------------------------------------------------- * Semi-DUPLICATE of 'InvokeTclMethod' in tclIORChan.c * - Semi because different structures are used. @@ -1966,15 +1972,16 @@ InvokeTclMethod( /* * Append the additional argument containing method specific details * behind the channel id. If specified. + * + * Because of the contract there is no need to increment the refcounts. + * The objects will survive the Tcl_EvalObjv without change. */ cmdc = rtPtr->argc; if (argOneObj) { - Tcl_IncrRefCount(argOneObj); rtPtr->argv[cmdc] = argOneObj; cmdc++; if (argTwoObj) { - Tcl_IncrRefCount(argTwoObj); rtPtr->argv[cmdc] = argTwoObj; cmdc++; } @@ -2035,15 +2042,13 @@ InvokeTclMethod( /* * Cleanup of the dynamic parts of the command. + * + * The detail objects survived the Tcl_EvalObjv without change because of + * the contract. Therefore there is no need to decrement the refcounts. Only + * the internal method object has to be disposed of. */ Tcl_DecrRefCount(methObj); - if (argOneObj) { - Tcl_DecrRefCount(argOneObj); - if (argTwoObj) { - Tcl_DecrRefCount(argTwoObj); - } - } /* * The resObj has a ref count of 1 at this location. This means that the @@ -2553,6 +2558,7 @@ ForwardProc( case ForwardedInput: { Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *) paramPtr->transform.buf, paramPtr->transform.size); + Tcl_IncrRefCount(bufObj); if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); @@ -2578,12 +2584,15 @@ ForwardProc( paramPtr->transform.buf = NULL; } } + + Tcl_DecrRefCount(bufObj); break; } case ForwardedOutput: { Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *) paramPtr->transform.buf, paramPtr->transform.size); + Tcl_IncrRefCount(bufObj); if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); @@ -2609,6 +2618,8 @@ ForwardProc( paramPtr->transform.buf = NULL; } } + + Tcl_DecrRefCount(bufObj); break; } @@ -3078,8 +3089,11 @@ TransformRead( /* ASSERT: rtPtr->mode & TCL_READABLE */ bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toRead); + Tcl_IncrRefCount(bufObj); + if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) { Tcl_SetChannelError(rtPtr->chan, resObj); + Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ *errorCodePtr = EINVAL; return 0; @@ -3087,6 +3101,8 @@ TransformRead( bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); ResultAdd(&rtPtr->result, bytev, bytec); + + Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ return 1; } @@ -3134,9 +3150,12 @@ TransformWrite( /* ASSERT: rtPtr->mode & TCL_WRITABLE */ bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite); + Tcl_IncrRefCount(bufObj); if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) { *errorCodePtr = EINVAL; Tcl_SetChannelError(rtPtr->chan, resObj); + + Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ return 0; } @@ -3145,6 +3164,8 @@ TransformWrite( bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec); + + Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ } diff --git a/tests/ioTrans.test b/tests/ioTrans.test index 7399bfb..8932874 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.8 2010/03/17 16:35:42 andreas_kupries Exp $ +# RCS: @(#) $Id: ioTrans.test,v 1.9 2010/08/04 16:49:02 andreas_kupries Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -854,6 +854,28 @@ test iortrans-11.1 {origin interpreter of moved transform destroyed during acces } -constraints {testchannel impossible} \ -result {Owner lost} + +test iortrans-11.2 {delete interp of reflected transform} -body { + interp create slave + + # Magic to get the test* commands into the slave + load {} Tcltest slave + + # Get base channel into the slave + set c [tempchan] + testchannel cut $c + interp eval slave [list testchannel splice $c] + interp eval slave [list set c $c] + + slave eval { + proc no-op args {} + proc driver {c sub args} {return {initialize finalize read write}} + set t [chan push $c [list driver $c]] + chan event $c readable no-op + } + interp delete slave +} -result {} -constraints {testchannel} + # ### ### ### ######### ######### ######### ## Same tests as above, but exercising the code forwarding and ## receiving driver operations to the originator thread. -- cgit v0.12