summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog8
-rw-r--r--generic/tclIORChan.c98
-rw-r--r--generic/tclIORTrans.c39
-rw-r--r--tests/ioTrans.test24
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 <andreask@activestate.com>
+
+ * generic/tclIORChan.c: [Bug 3034840]: Fixed reference counting
+ * generic/tclIORTrans.c: in InvokeTclMethod and callers.
+ * tests/ioTrans.test:
+
2010-08-03 Andreas Kupries <andreask@activestate.com>
* tests/var.test (var-19.1): [Bug 3037525]: Added test
demonstrating the local hashtable deletion crash and fix.
-2010-08-03 Andreas Kupries <andreask@activestate.com>
-
* 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.
generated by cgit v0.12 at 2024-07-15 17:09:09 (GMT)