Pulling *more* changes from zipfs

8 files changed, 141 insertions, 71 deletions

diff --git a/doc/tclvars.n b/doc/tclvars.n
index a8fba47..a256c21 100644
--- a/doc/tclvars.n
+++ b/doc/tclvars.n
@@ -299,6 +299,11 @@ so extension writers can specify which package to load depending on the
 C run-time library that is in use.  This is not an indication that this core
 contains symbols.
 .TP
+\fBengine\fR
+.
+The name of the Tcl language implementation.  When the interpreter is first
+created, this is always set to the string \fBTcl\fR.
+.TP
 \fBmachine\fR
 .
 The instruction set executed by this machine, such as
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 5c5bc64..e5d7406 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -916,6 +916,13 @@ Tcl_CreateInterp(void)
     TclInitEmbeddedConfigurationInformation(interp);
 
     /*
+     * TIP #440: Declare the name of the script engine to be "Tcl".
+     */
+
+    Tcl_SetVar2(interp, "tcl_platform", "engine", "Tcl",
+	    TCL_GLOBAL_ONLY);
+
+    /*
      * Compute the byte order of this machine.
      */
 
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 34eb5ad..9df5029 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -898,10 +898,10 @@ ObjectRenamedTrace(
 /*
  * ----------------------------------------------------------------------
  *
- * ReleaseClassContents --
+ * ClearMixins, ClearSuperclasses --
  *
- *	Tear down the special class data structure, including deleting all
- *	dependent classes and objects.
+ *	Utility functions for correctly clearing the list of mixins or
+ *	superclasses of a class. Will ckfree() the list storage.
  *
  * ----------------------------------------------------------------------
  */
@@ -913,10 +913,15 @@ ClearMixins(
     int i;
     Class *mixinPtr;
 
+    if (clsPtr->mixins.num == 0) {
+	return;
+    }
+
     FOREACH(mixinPtr, clsPtr->mixins) {
 	TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
     }
     ckfree(clsPtr->mixins.list);
+    clsPtr->mixins.list = NULL;
     clsPtr->mixins.num = 0;
 }
 
@@ -927,12 +932,28 @@ ClearSuperclasses(
     int i;
     Class *superPtr;
 
+    if (clsPtr->superclasses.num == 0) {
+	return;
+    }
+
     FOREACH(superPtr, clsPtr->superclasses) {
 	TclOORemoveFromSubclasses(clsPtr, superPtr);
     }
     ckfree(clsPtr->superclasses.list);
+    clsPtr->superclasses.list = NULL;
     clsPtr->superclasses.num = 0;
 }
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ReleaseClassContents --
+ *
+ *	Tear down the special class data structure, including deleting all
+ *	dependent classes and objects.
+ *
+ * ----------------------------------------------------------------------
+ */
 
 static void
 ReleaseClassContents(
@@ -1002,16 +1023,11 @@ ReleaseClassContents(
      */
 
     FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
-	if (mixinSubclassPtr == NULL) {
-	    continue;
-	}
 	if (!Deleted(mixinSubclassPtr->thisPtr)) {
 	    Tcl_DeleteCommandFromToken(interp,
 		    mixinSubclassPtr->thisPtr->command);
 	}
-	if (mixinSubclassPtr->mixins.num) {
-	    ClearMixins(mixinSubclassPtr);
-	}
+	ClearMixins(mixinSubclassPtr);
 	DelRef(mixinSubclassPtr->thisPtr);
 	DelRef(mixinSubclassPtr);
     }
@@ -1026,15 +1042,13 @@ ReleaseClassContents(
      */
 
     FOREACH(subclassPtr, clsPtr->subclasses) {
-	if (subclassPtr == NULL || IsRoot(subclassPtr)) {
+	if (IsRoot(subclassPtr)) {
 	    continue;
 	}
 	if (!Deleted(subclassPtr->thisPtr)) {
 	    Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
 	}
-	if (subclassPtr->superclasses.num) {
-	    ClearSuperclasses(subclassPtr);
-	}
+	ClearSuperclasses(subclassPtr);
 	DelRef(subclassPtr->thisPtr);
 	DelRef(subclassPtr);
     }
@@ -1230,6 +1244,10 @@ ObjectNamespaceDeleted(
 	oPtr->metadataPtr = NULL;
     }
 
+    /*
+     * If this was a class, there's additional deletion work to do.
+     */
+
     if (clsPtr != NULL) {
 	Tcl_ObjectMetadataType *metadataTypePtr;
 	ClientData value;
@@ -1251,12 +1269,10 @@ ObjectNamespaceDeleted(
 	    clsPtr->filters.num = 0;
 	}
 
-	if (clsPtr->mixins.num) {
-	    ClearMixins(clsPtr);
-	}
-	if (clsPtr->superclasses.num) {
-	    ClearSuperclasses(clsPtr);
-	}
+	ClearMixins(clsPtr);
+
+	ClearSuperclasses(clsPtr);
+
 	if (clsPtr->subclasses.list) {
 	    ckfree(clsPtr->subclasses.list);
 	    clsPtr->subclasses.num = 0;
@@ -1398,9 +1414,7 @@ TclOORemoveFromSubclasses(
     return;
 
   removeSubclass:
-    if (Deleted(superPtr->thisPtr)) {
-	superPtr->subclasses.list[i] = NULL;
-    } else {
+    if (!Deleted(superPtr->thisPtr)) {
 	superPtr->subclasses.num--;
 	if (i < superPtr->subclasses.num) {
 	    superPtr->subclasses.list[i] =
@@ -1471,9 +1485,7 @@ TclOORemoveFromMixinSubs(
     return;
 
   removeSubclass:
-    if (Deleted(superPtr->thisPtr)) {
-	superPtr->mixinSubs.list[i] = NULL;
-    } else {
+    if (!Deleted(superPtr->thisPtr)) {
 	superPtr->mixinSubs.num--;
 	if (i < superPtr->mixinSubs.num) {
 	    superPtr->mixinSubs.list[i] =
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 63a6740..9794f59 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -6872,9 +6872,9 @@ NREUnwind_callback(
                 &none, NULL);
     } else {
         Tcl_Obj *idata[3];
-        idata[0] = Tcl_NewIntObj((int) (data[1] - data[0]));
-        idata[1] = Tcl_NewIntObj((int) (data[2] - data[0]));
-        idata[2] = Tcl_NewIntObj((int) ((void *) &none   - data[0]));
+        idata[0] = Tcl_NewIntObj((int) ((char *) data[1] - (char *) data[0]));
+        idata[1] = Tcl_NewIntObj((int) ((char *) data[2] - (char *) data[0]));
+        idata[2] = Tcl_NewIntObj((int) ((char *) &none   - (char *) data[0]));
         Tcl_SetObjResult(interp, Tcl_NewListObj(3, idata));
     }
     return TCL_OK;
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index ba3e9cb..50d9a30 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -1164,6 +1164,14 @@ Tcl_ZlibStreamPut(
 	zshPtr->stream.next_in = Tcl_GetByteArrayFromObj(data, &size);
 	zshPtr->stream.avail_in = size;
 
+	/*
+	 * Must not do a zero-length compress. [Bug 25842c161]
+	 */
+
+	if (size == 0) {
+	    return TCL_OK;
+	}
+
 	if (HaveDictToSet(zshPtr)) {
 	    e = SetDeflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
 	    if (e != Z_OK) {
@@ -1186,32 +1194,27 @@ Tcl_ZlibStreamPut(
 	zshPtr->stream.next_out = (Bytef *) dataTmp;
 
 	e = deflate(&zshPtr->stream, flush);
-	if ((e==Z_OK || e==Z_BUF_ERROR) && (zshPtr->stream.avail_out == 0)) {
-	    if (outSize - zshPtr->stream.avail_out > 0) {
-		/*
-		 * Output buffer too small.
-		 */
-
-		obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp,
-			outSize - zshPtr->stream.avail_out);
+	while (e == Z_BUF_ERROR) {
+	    /*
+	     * Output buffer too small to hold the data being generated; so
+	     * put a new buffer into place after saving the old generated
+	     * data to the outData list.
+	     */
 
-		/*
-		 * Now append the compressed data to the outData list.
-		 */
+	    obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp, outSize);
+	    Tcl_ListObjAppendElement(NULL, zshPtr->outData, obj);
 
-		Tcl_ListObjAppendElement(NULL, zshPtr->outData, obj);
-	    }
 	    if (outSize < 0xFFFF) {
 		outSize = 0xFFFF;	/* There may be *lots* of data left to
 					 * output... */
-		ckfree(dataTmp);
-		dataTmp = ckalloc(outSize);
+		dataTmp = ckrealloc(dataTmp, outSize);
 	    }
 	    zshPtr->stream.avail_out = outSize;
 	    zshPtr->stream.next_out = (Bytef *) dataTmp;
 
 	    e = deflate(&zshPtr->stream, flush);
 	}
+
 	if (e != Z_OK && !(flush==Z_FINISH && e==Z_STREAM_END)) {
 	    if (zshPtr->interp) {
 		ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
@@ -3106,6 +3109,64 @@ ZlibTransformOutput(
 /*
  *----------------------------------------------------------------------
  *
+ * ZlibTransformFlush --
+ *
+ *	How to perform a flush of a compressing transform.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ZlibTransformFlush(
+    Tcl_Interp *interp,
+    ZlibChannelData *cd,
+    int flushType)
+{
+    int e, len;
+
+    cd->outStream.avail_in = 0;
+    do {
+	/*
+	 * Get the bytes to go out of the compression engine.
+	 */
+
+	cd->outStream.next_out = (Bytef *) cd->outBuffer;
+	cd->outStream.avail_out = cd->outAllocated;
+
+	e = deflate(&cd->outStream, flushType);
+	if (e != Z_OK && e != Z_BUF_ERROR) {
+	    ConvertError(interp, e, cd->outStream.adler);
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Write the bytes we've received to the next layer.
+	 */
+
+	len = cd->outStream.next_out - (Bytef *) cd->outBuffer;
+	if (len > 0 && Tcl_WriteRaw(cd->parent, cd->outBuffer, len) < 0) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "problem flushing channel: %s",
+		    Tcl_PosixError(interp)));
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * If we get to this point, either we're in the Z_OK or the
+	 * Z_BUF_ERROR state. In the former case, we're done. In the latter
+	 * case, it's because there's more bytes to go than would fit in the
+	 * buffer we provided, and we need to go round again to get some more.
+	 *
+	 * We also stop the loop if we would have done a zero-length write.
+	 * Those can cause problems at the OS level.
+	 */
+    } while (len > 0 && e == Z_BUF_ERROR);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * ZlibTransformSetOption --
  *
  *	Writing side of [fconfigure] on our channel.
@@ -3178,32 +3239,7 @@ ZlibTransformSetOption(			/* not used */
 	     * Try to actually do the flush now.
 	     */
 
-	    cd->outStream.avail_in = 0;
-	    while (1) {
-		int e;
-
-		cd->outStream.next_out = (Bytef *) cd->outBuffer;
-		cd->outStream.avail_out = cd->outAllocated;
-
-		e = deflate(&cd->outStream, flushType);
-		if (e == Z_BUF_ERROR) {
-		    break;
-		} else if (e != Z_OK) {
-		    ConvertError(interp, e, cd->outStream.adler);
-		    return TCL_ERROR;
-		} else if (cd->outStream.avail_out == 0) {
-		    break;
-		}
-
-		if (Tcl_WriteRaw(cd->parent, cd->outBuffer,
-			cd->outStream.next_out - (Bytef *) cd->outBuffer)<0) {
-		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			    "problem flushing channel: %s",
-			    Tcl_PosixError(interp)));
-		    return TCL_ERROR;
-		}
-	    }
-	    return TCL_OK;
+	    return ZlibTransformFlush(interp, cd, flushType);
 	}
     } else {
 	if (optionName && strcmp(optionName, "-limit") == 0) {
diff --git a/tests/platform.test b/tests/platform.test
index cc00d49..c826444 100644
--- a/tests/platform.test
+++ b/tests/platform.test
@@ -23,6 +23,10 @@ catch [list package require -exact Tcltest [info patchlevel]]
 
 testConstraint testCPUID [llength [info commands testcpuid]]
 
+test platform-1.0 {tcl_platform(engine)} {
+  set tcl_platform(engine)
+} {Tcl}
+
 test platform-1.1 {TclpSetVariables: tcl_platform} {
     interp create i
     i eval {catch {unset tcl_platform(debug)}}
@@ -30,7 +34,7 @@ test platform-1.1 {TclpSetVariables: tcl_platform} {
     set result [i eval {lsort [array names tcl_platform]}]
     interp delete i
     set result
-} {byteOrder machine os osVersion pathSeparator platform pointerSize user wordSize}
+} {byteOrder engine machine os osVersion pathSeparator platform pointerSize user wordSize}
 
 # Test assumes twos-complement arithmetic, which is true of virtually
 # everything these days.  Note that this does *not* use wide(), and
diff --git a/tests/safe.test b/tests/safe.test
index 859f352..94c1755 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -174,7 +174,7 @@ test safe-6.3 {test safe interpreters knowledge of the world} {
     }
     set r [lsearch -all -inline -not -exact $r "threaded"]
     lsort $r
-} {byteOrder pathSeparator platform pointerSize wordSize}
+} {byteOrder engine pathSeparator platform pointerSize wordSize}
 
 # More test should be added to check that hostname, nameofexecutable, aren't
 # leaking infos, but they still do...
diff --git a/tests/zlib.test b/tests/zlib.test
index b1d43fb..7a486ba 100644
--- a/tests/zlib.test
+++ b/tests/zlib.test
@@ -132,6 +132,12 @@ test zlib-7.6 {zlib stream} zlib {
     $s close
     lappend result $data
 } {{} 69f34b6a abcdeEDCBA..}
+test zlib-7.7 {zlib stream: Bug 25842c161} -constraints zlib -body {
+    set s [zlib stream deflate]
+    $s put {}
+} -cleanup {
+    catch {$s close}
+} -result ""
 
 test zlib-8.1 {zlib transformation} -constraints zlib -setup {
     set file [makeFile {} test.gz]