* generic/tclZlib.c: Purge code that wrote to the object returned by

	Tcl_GetObjResult, as we don't want to do that anti-pattern no more.

2 files changed, 62 insertions, 52 deletions

diff --git a/ChangeLog b/ChangeLog
index 8e372eb..4f8e598 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,8 +1,13 @@
+2010-10-19  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclZlib.c: Purge code that wrote to the object returned by
+	Tcl_GetObjResult, as we don't want to do that anti-pattern no more.
+
 2010-10-18  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* tools/uniParse.tcl:   [Bug 3085863]: tclUniData 9 years old
+	* tools/uniParse.tcl:   [Bug 3085863]: tclUniData was 9 years old;
 	Ignore non-BMP characters and fix comment about UnicodeData.txt file.
-	* generic/regcomp.c:    fix comment
+	* generic/regcomp.c:    Fix comment
 	* tests/utf.test:       Add some Unicode 6 testcases
 
 2010-10-17  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 8937648..b88e823 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclZlib.c,v 1.38 2010/06/21 11:25:26 nijtmans Exp $
+ * RCS: @(#) $Id: tclZlib.c,v 1.39 2010/10/19 21:23:32 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -567,7 +567,7 @@ Tcl_ZlibStreamInit(
      */
 
     if (interp != NULL) {
-	if (Tcl_Eval(interp, "incr ::tcl::zlib::cmdcounter") != TCL_OK) {
+	if (Tcl_Eval(interp, "::incr ::tcl::zlib::cmdcounter") != TCL_OK) {
 	    goto error;
 	}
 	Tcl_DStringInit(&cmdname);
@@ -1217,24 +1217,10 @@ Tcl_ZlibDeflate(
     gz_header *headerPtr = NULL;
     Tcl_Obj *obj;
 
-    /*
-     * We pass the data back in the interp result obj...
-     */
-
     if (!interp) {
 	return TCL_ERROR;
     }
-    obj = Tcl_GetObjResult(interp);
-
-    /*
-     * Make sure that the result is an unshared object. [Bug 2947783]
-     */
-
-    if (Tcl_IsShared(obj)) {
-	obj = Tcl_DuplicateObj(obj);
-	Tcl_SetObjResult(interp, obj);
-    }
-
+ 
     /*
      * Compressed format is specified by the wbits parameter. See zlib.h for
      * details.
@@ -1274,6 +1260,12 @@ Tcl_ZlibDeflate(
     }
 
     /*
+     * Allocate some space to store the output.
+     */
+
+    TclNewObj(obj);
+
+    /*
      * Obtain the pointer to the byte array, we'll pass this pointer straight
      * to the deflate command.
      */
@@ -1341,10 +1333,12 @@ Tcl_ZlibDeflate(
      */
 
     Tcl_SetByteArrayLength(obj, stream.total_out);
+    Tcl_SetObjResult(interp, obj);
     return TCL_OK;
 
   error:
     ConvertError(interp, e);
+    TclDecrRefCount(obj);
     return TCL_ERROR;
 }
 
@@ -1373,23 +1367,9 @@ Tcl_ZlibInflate(
     Tcl_Obj *obj;
     char *nameBuf = NULL, *commentBuf = NULL;
 
-    /*
-     * We pass the data back in the interp result obj...
-     */
-
     if (!interp) {
 	return TCL_ERROR;
     }
-    obj = Tcl_GetObjResult(interp);
-
-    /*
-     * Make sure that the result is an unshared object. [Bug 2947783]
-     */
-
-    if (Tcl_IsShared(obj)) {
-	obj = Tcl_DuplicateObj(obj);
-	Tcl_SetObjResult(interp, obj);
-    }
 
     /*
      * Compressed format is specified by the wbits parameter. See zlib.h for
@@ -1443,6 +1423,7 @@ Tcl_ZlibInflate(
 	}
     }
 
+    TclNewObj(obj);
     outData = Tcl_SetByteArrayLength(obj, bufferSize);
     memset(&stream, 0, sizeof(z_stream));
     stream.avail_in = (uInt) inLen+1;	/* +1 because zlib can "over-request"
@@ -1530,9 +1511,11 @@ Tcl_ZlibInflate(
 	ckfree(nameBuf);
 	ckfree(commentBuf);
     }
+    Tcl_SetObjResult(interp, obj);
     return TCL_OK;
 
   error:
+    TclDecrRefCount(obj);
     ConvertError(interp, e);
     if (nameBuf) {
 	ckfree(nameBuf);
@@ -1593,7 +1576,6 @@ ZlibCmd(
     unsigned start, buffersize = 0;
     Tcl_ZlibStream zh;
     Byte *data;
-    Tcl_Obj *obj = Tcl_GetObjResult(interp);
     Tcl_Obj *headerDictObj, *headerVarObj;
     const char *extraInfoStr = NULL;
     static const char *const commands[] = {
@@ -1638,8 +1620,8 @@ ZlibCmd(
 	    start = Tcl_ZlibAdler32(0, NULL, 0);
 	}
 	data = Tcl_GetByteArrayFromObj(objv[2], &dlen);
-	Tcl_SetWideIntObj(obj,
-		(Tcl_WideInt) Tcl_ZlibAdler32(start, data, dlen));
+	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
+		Tcl_ZlibAdler32(start, data, dlen)));
 	return TCL_OK;
     case CMD_CRC:			/* crc32 str ?startvalue?
 					 * -> checksum */
@@ -1655,8 +1637,8 @@ ZlibCmd(
 	    start = Tcl_ZlibCRC32(0, NULL, 0);
 	}
 	data = Tcl_GetByteArrayFromObj(objv[2], &dlen);
-	Tcl_SetWideIntObj(obj,
-		(Tcl_WideInt) Tcl_ZlibCRC32(start, data, dlen));
+	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
+		Tcl_ZlibCRC32(start, data, dlen)));
 	return TCL_OK;
     case CMD_DEFLATE:			/* deflate data ?level?
 					 * -> rawCompressedData */
@@ -2023,10 +2005,8 @@ ZlibStreamCmd(
     Tcl_Obj *const objv[])
 {
     Tcl_ZlibStream zstream = cd;
-    int command, index, count;
-    Tcl_Obj *obj = Tcl_GetObjResult(interp);
-    int buffersize;
-    int flush = -1, i;
+    int command, index, count, code, buffersize, flush = -1, i;
+    Tcl_Obj *obj;
     static const char *const cmds[] = {
 	"add", "checksum", "close", "eof", "finalize", "flush",
 	"fullflush", "get", "put", "reset",
@@ -2110,7 +2090,14 @@ ZlibStreamCmd(
 		flush) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	return Tcl_ZlibStreamGet(zstream, obj, -1);
+	TclNewObj(obj);
+	code = Tcl_ZlibStreamGet(zstream, obj, -1);
+	if (code == TCL_OK) {
+	    Tcl_SetObjResult(interp, obj);
+	} else {
+	    TclDecrRefCount(obj);
+	}
+	return code;
 
     case zs_put:		/* $strm put ?$flushopt? $data */
 	for (i=2; i<objc-1; i++) {
@@ -2169,33 +2156,50 @@ ZlibStreamCmd(
 		return TCL_ERROR;
 	    }
 	}
-	return Tcl_ZlibStreamGet(zstream, obj, count);
+	TclNewObj(obj);
+	code = Tcl_ZlibStreamGet(zstream, obj, count);
+	if (code == TCL_OK) {
+	    Tcl_SetObjResult(interp, obj);
+	} else {
+	    TclDecrRefCount(obj);
+	}
+	return code;
     case zs_flush:		/* $strm flush */
 	if (objc != 2) {
 	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
 	    return TCL_ERROR;
 	}
-	Tcl_SetObjLength(obj, 0);
-	return Tcl_ZlibStreamPut(zstream, obj, Z_SYNC_FLUSH);
+	TclNewObj(obj);
+	Tcl_IncrRefCount(obj);
+	code = Tcl_ZlibStreamPut(zstream, obj, Z_SYNC_FLUSH);
+	TclDecrRefCount(obj);
+	return code;
     case zs_fullflush:		/* $strm fullflush */
 	if (objc != 2) {
 	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
 	    return TCL_ERROR;
 	}
-	Tcl_SetObjLength(obj, 0);
-	return Tcl_ZlibStreamPut(zstream, obj, Z_FULL_FLUSH);
+	TclNewObj(obj);
+	Tcl_IncrRefCount(obj);
+	code = Tcl_ZlibStreamPut(zstream, obj, Z_FULL_FLUSH);
+	TclDecrRefCount(obj);
+	return code;
     case zs_finalize:		/* $strm finalize */
 	if (objc != 2) {
 	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
 	    return TCL_ERROR;
 	}
+
 	/*
 	 * The flush commands slightly abuse the empty result obj as input
 	 * data.
 	 */
 
-	Tcl_SetObjLength(obj, 0);
-	return Tcl_ZlibStreamPut(zstream, obj, Z_FINISH);
+	TclNewObj(obj);
+	Tcl_IncrRefCount(obj);
+	code = Tcl_ZlibStreamPut(zstream, obj, Z_FINISH);
+	TclDecrRefCount(obj);
+	return code;
     case zs_close:		/* $strm close */
 	if (objc != 2) {
 	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
@@ -2207,14 +2211,15 @@ ZlibStreamCmd(
 	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
 	    return TCL_ERROR;
 	}
-	Tcl_SetIntObj(obj, Tcl_ZlibStreamEof(zstream));
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_ZlibStreamEof(zstream)));
 	return TCL_OK;
     case zs_checksum:		/* $strm checksum */
 	if (objc != 2) {
 	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
 	    return TCL_ERROR;
 	}
-	Tcl_SetWideIntObj(obj, (Tcl_WideInt) Tcl_ZlibStreamChecksum(zstream));
+	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
+		Tcl_ZlibStreamChecksum(zstream)));
 	return TCL_OK;
     case zs_reset:		/* $strm reset */
 	if (objc != 2) {