* generic/tclZlib.c (Tcl_ZlibStreamGet): [Bug 3081008]: Ensure that

	when a bytearray gets its internals entangled with zlib for more than
	a passing moment, that bytearray will never be shimmered away. This
	increases the amount of copying but is simple to get right, which is a
	reasonable trade-off.

	* generic/tclStringObj.c (Tcl_AppendObjToObj): Added some special
	cases so that most of the time when you build up a bytearray by
	appending, it actually ends up being a bytearray rather than
	shimmering back and forth to string.

	* tests/http11.test (check_crc): Use a simpler way to express the
	functionality of this procedure.

4 files changed, 40 insertions, 7 deletions

diff --git a/ChangeLog b/ChangeLog
index 4f8e598..d07a302 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,19 @@
 2010-10-19  Donal K. Fellows  <dkf@users.sf.net>
 
+	* generic/tclZlib.c (Tcl_ZlibStreamGet): [Bug 3081008]: Ensure that
+	when a bytearray gets its internals entangled with zlib for more than
+	a passing moment, that bytearray will never be shimmered away. This
+	increases the amount of copying but is simple to get right, which is a
+	reasonable trade-off.
+
+	* generic/tclStringObj.c (Tcl_AppendObjToObj): Added some special
+	cases so that most of the time when you build up a bytearray by
+	appending, it actually ends up being a bytearray rather than
+	shimmering back and forth to string.
+
+	* tests/http11.test (check_crc): Use a simpler way to express the
+	functionality of this procedure.
+
 	* 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.
 
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 9e2e3aa..96e01d0 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -33,7 +33,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStringObj.c,v 1.137 2010/04/30 20:52:51 dgp Exp $ */
+ * RCS: @(#) $Id: tclStringObj.c,v 1.138 2010/10/19 22:50:37 dkf Exp $ */
 
 #include "tclInt.h"
 #include "tommath.h"
@@ -1228,13 +1228,23 @@ Tcl_AppendObjToObj(
     const char *bytes;
 
     /*
+     * Special case: second object is standard-empty is fast case. We know
+     * that appending nothing to anything leaves that starting anything...
+     */
+
+    if (appendObjPtr->bytes == tclEmptyStringRep) {
+	return;
+    }
+
+    /*
      * Handle append of one bytearray object to another as a special case.
      * Note that we only do this when the objects don't have string reps; if
      * it did, then appending the byte arrays together could well lose
      * information; this is a special-case optimization only.
      */
 
-    if (TclIsPureByteArray(objPtr) && TclIsPureByteArray(appendObjPtr)) {
+    if ((TclIsPureByteArray(objPtr) || objPtr->bytes == tclEmptyStringRep)
+	    && TclIsPureByteArray(appendObjPtr)) {
 	unsigned char *bytesSrc;
 	int lengthSrc, lengthTotal;
 
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index b88e823..e429b86 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.39 2010/10/19 21:23:32 dkf Exp $
+ * RCS: @(#) $Id: tclZlib.c,v 1.40 2010/10/19 22:50:37 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -1047,10 +1047,15 @@ Tcl_ZlibStreamGet(
 	    if (listLen > 0) {
 		/*
 		 * There is more input available, get it from the list and
-		 * give it to zlib.
+		 * give it to zlib. At this point, the data must not be shared
+		 * since we require the bytearray representation to not vanish
+		 * under our feet. [Bug 3081008]
 		 */
 
 		Tcl_ListObjIndex(NULL, zshPtr->inData, 0, &itemObj);
+		if (Tcl_IsShared(itemObj)) {
+		    itemObj = Tcl_DuplicateObj(itemObj);
+		}
 		itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
 		Tcl_IncrRefCount(itemObj);
 		zshPtr->currentInput = itemObj;
@@ -1062,7 +1067,6 @@ Tcl_ZlibStreamGet(
 		 */
 
 		Tcl_ListObjReplace(NULL, zshPtr->inData, 0, 1, 0, NULL);
-		listLen--;
 	    }
 	}
 
@@ -1092,10 +1096,15 @@ Tcl_ZlibStreamGet(
 	    }
 
 	    /*
-	     * Get the next block of data to go to inflate.
+	     * Get the next block of data to go to inflate. At this point, the
+	     * data must not be shared since we require the bytearray
+	     * representation to not vanish under our feet. [Bug 3081008]
 	     */
 
 	    Tcl_ListObjIndex(zshPtr->interp, zshPtr->inData, 0, &itemObj);
+	    if (Tcl_IsShared(itemObj)) {
+		itemObj = Tcl_DuplicateObj(itemObj);
+	    }
 	    itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
 	    Tcl_IncrRefCount(itemObj);
 	    zshPtr->currentInput = itemObj;
diff --git a/tests/http11.test b/tests/http11.test
index 0cecaa1..230ce5a 100644
--- a/tests/http11.test
+++ b/tests/http11.test
@@ -62,7 +62,7 @@ proc meta {tok {key ""}} {
 
 proc check_crc {tok args} {
     set crc [meta $tok x-crc32]
-    if {[llength $args]} {set data [lindex $args 0]} else {set data [http::data $tok]}
+    set data [expr {[llength $args] ? [lindex $args 0] : [http::data $tok]}]
     set chk [format %x [zlib crc32 $data]]
     if {$crc ne $chk} {
         return  "crc32 mismatch: $crc ne $chk"