Tcl Source Code

Artifact [f4b3c1508e]
Login

Artifact f4b3c1508eadfb6fa7fec4b5eaeea5f70f7691fe:

Attachment "tclIORChan.patch.85" to ticket [3034840fff] added by andreas_kupries 2010-08-04 05:28:06.
Index: generic/tclIORChan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIORChan.c,v
retrieving revision 1.28.2.10
diff -w -u -r1.28.2.10 tclIORChan.c
--- generic/tclIORChan.c	30 Mar 2010 21:17:30 -0000	1.28.2.10
+++ generic/tclIORChan.c	3 Aug 2010 22:27:01 -0000
@@ -586,6 +586,7 @@
      */
 
     modeObj = DecodeEventMask(mode);
+    /* assert modeObj.refCount == 1 */
     result = InvokeTclMethod(rcPtr, "initialize", modeObj, NULL, &resObj);
     Tcl_DecrRefCount(modeObj);
     if (result != TCL_OK) {
@@ -1241,6 +1242,8 @@
     Tcl_Preserve(rcPtr);
 
     toReadObj = Tcl_NewIntObj(toRead);
+    Tcl_IncrRefCount(toReadObj);
+
     if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK) {
 	int code = ErrnoReturn (rcPtr, resObj);
 
@@ -1267,6 +1270,7 @@
     }
 
  stop:
+    Tcl_DecrRefCount(toReadObj);
     Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
     Tcl_Release(rcPtr);
     return bytec;
@@ -1353,6 +1357,8 @@
     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);
 
@@ -1392,6 +1398,7 @@
 
     *errorCodePtr = EOK;
  stop:
+    Tcl_DecrRefCount(bufObj);
     Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
     Tcl_Release(rcPtr);
     return written;
@@ -1462,6 +1469,9 @@
     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;
@@ -1479,6 +1489,8 @@
 
     *errorCodePtr = EOK;
  stop:
+    Tcl_DecrRefCount(offObj);
+    Tcl_DecrRefCount(baseObj);
     Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
     Tcl_Release(rcPtr);
     return newLoc;
@@ -1574,6 +1586,7 @@
     Tcl_Preserve(rcPtr);
 
     maskObj = DecodeEventMask(mask);
+    /* assert maskObj.refCount == 1 */
     (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
     Tcl_DecrRefCount(maskObj);
 
@@ -1629,6 +1642,7 @@
 #endif
 
     blockObj = Tcl_NewBooleanObj(!nonblocking);
+    Tcl_IncrRefCount(blockObj);
 
     Tcl_Preserve(rcPtr);
 
@@ -1639,6 +1653,7 @@
 	errorNum = EOK;
     }
 
+    Tcl_DecrRefCount(blockObj);
     Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
 
     Tcl_Release(rcPtr);
@@ -1701,11 +1716,17 @@
 
     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;
@@ -1742,7 +1763,7 @@
     ReflectedChannel *rcPtr = (ReflectedChannel*) clientData;
     Tcl_Obj *optionObj;
     Tcl_Obj *resObj;		/* Result data for 'configure' */
-    int listc;
+    int listc, result = TCL_OK;
     Tcl_Obj **listv;
     const char *method;
 
@@ -1792,6 +1813,7 @@
 
 	method = "cget";
 	optionObj = Tcl_NewStringObj(optionName, -1);
+        Tcl_IncrRefCount(optionObj);
     }
 
     Tcl_Preserve(rcPtr);
@@ -1849,13 +1871,17 @@
     }
 
  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;
 }
 
 /*
@@ -2153,6 +2179,11 @@
  * 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, ...}
+ *
  *----------------------------------------------------------------------
  */
 
@@ -2183,16 +2214,10 @@
 	}
 
 	/*
-	 * Cleanup of the dynamic parts of the command.
+         * Not touching argOneObj, argTwoObj, they have not been used.
+         * See the contract as well.
 	 */
 
-	if (argOneObj) {
-	    Tcl_DecrRefCount(argOneObj);
-	    if (argTwoObj) {
-		Tcl_DecrRefCount(argTwoObj);
-	    }
-	}
-
 	return TCL_ERROR;
     }
 
@@ -2218,11 +2243,9 @@
 
     cmdc = rcPtr->argc;
     if (argOneObj) {
-	Tcl_IncrRefCount(argOneObj);
 	rcPtr->argv[cmdc] = argOneObj;
 	cmdc++;
 	if (argTwoObj) {
-	    Tcl_IncrRefCount(argTwoObj);
 	    rcPtr->argv[cmdc] = argTwoObj;
 	    cmdc++;
 	}
@@ -2285,15 +2308,13 @@
 
     /*
      * 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
@@ -2844,6 +2865,7 @@
 
     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){
@@ -2876,12 +2898,14 @@
 	    }
 	}
         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) {
@@ -2911,6 +2935,7 @@
 	    }
 	}
         Tcl_Release(rcPtr);
+        Tcl_DecrRefCount(bufObj);
 	break;
     }
 
@@ -2920,6 +2945,9 @@
 		(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);
@@ -2945,11 +2973,14 @@
 	    }
 	}
         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);
@@ -2960,6 +2991,7 @@
 
     case ForwardedBlock: {
 	Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking);
+        Tcl_IncrRefCount(blockObj);
 
         Tcl_Preserve(rcPtr);
 	if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL,
@@ -2967,6 +2999,7 @@
 	    ForwardSetObjError(paramPtr, resObj);
 	}
         Tcl_Release(rcPtr);
+        Tcl_DecrRefCount(blockObj);
 	break;
     }
 
@@ -2974,12 +3007,16 @@
 	Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -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;
     }
 
@@ -2989,6 +3026,7 @@
 	 */
 
 	Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1);
+        Tcl_IncrRefCount(optionObj);
 
         Tcl_Preserve(rcPtr);
 	if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){
@@ -2998,6 +3036,7 @@
 		    TclGetString(resObj), -1);
 	}
         Tcl_Release(rcPtr);
+        Tcl_DecrRefCount(optionObj);
 	break;
     }
 
Index: tests/ioCmd.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/ioCmd.test,v
retrieving revision 1.36.2.8
diff -w -u -r1.36.2.8 ioCmd.test
--- tests/ioCmd.test	9 Mar 2010 21:13:13 -0000	1.36.2.8
+++ tests/ioCmd.test	3 Aug 2010 22:27:01 -0000
@@ -1970,6 +1970,19 @@
 } -constraints {testchannel impossible} \
     -result {Owner lost}
 
+test iocmd-32.2 {delete interp of reflected chan} {
+    # Bug 3034840
+    # Run this test in an interp with memory debugging to panic
+    # on the double free
+    interp create slave
+    slave eval {
+        proc no-op args {}
+        proc driver {sub args} {return {initialize finalize watch read}}
+        chan event [chan create read driver] readable no-op
+    }
+    interp delete slave
+} {}
+
 # ### ### ### ######### ######### #########
 ## Same tests as above, but exercising the code forwarding and
 ## receiving driver operations to the originator thread.