* generic/tclCmdMZ.c (Tcl_SubstObj): Corrected and added test for

        * tests/subst.test (subst-2.4):         Tcl_SubstObj's incorrect
        halting of substitution at the first \x00 byte.  [Bug 685106]

3 files changed, 25 insertions, 20 deletions

diff --git a/ChangeLog b/ChangeLog
index bb0f452..9fbf31c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
 2003-03-12  Don Porter  <dgp@users.sourceforge.net>
 
+	* generic/tclCmdMZ.c (Tcl_SubstObj):	Corrected and added test for
+	* tests/subst.test (subst-2.4):		Tcl_SubstObj's incorrect
+	halting of substitution at the first \x00 byte.  [Bug 685106]
+
 	* generic/tclInterp.c (Tcl_InterpObjCmd):	Corrected and added
 	* tests/interp.test (interp-2.13):  		test for option
 	parsing beyond objc for [interp create --].  Thanks to Marco Maggi.
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 2ae4819..939914a 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.82 2003/02/27 00:54:36 hobbs Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.82.2.1 2003/03/12 18:04:39 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -2526,17 +2526,12 @@ Tcl_SubstObj(interp, objPtr, flags)
 {
     Tcl_Obj *resultObj;
     char *p, *old;
+    int length;
 
-    old = p = Tcl_GetString(objPtr);
+    old = p = Tcl_GetStringFromObj(objPtr, &length);
     resultObj = Tcl_NewStringObj("", 0);
-    while (1) {
+    while (length) {
 	switch (*p) {
-	case 0:
-	    if (p != old) {
-		Tcl_AppendToObj(resultObj, old, p-old);
-	    }
-	    return resultObj;
-
 	case '\\':
 	    if (flags & TCL_SUBST_BACKSLASHES) {
 		char buf[TCL_UTF_MAX];
@@ -2547,10 +2542,10 @@ Tcl_SubstObj(interp, objPtr, flags)
 		}
 		Tcl_AppendToObj(resultObj, buf,
 				Tcl_UtfBackslash(p, &count, buf));
-		p += count;
+		p += count; length -= count;
 		old = p;
 	    } else {
-		p++;
+		p++; length--;
 	    }
 	    break;
 
@@ -2577,13 +2572,14 @@ Tcl_SubstObj(interp, objPtr, flags)
 		     * There isn't a variable name after all: the $ is
 		     * just a $.
 		     */
-		    p++;
+		    p++; length--;
 		    break;
 		}
 		if (p != old) {
 		    Tcl_AppendToObj(resultObj, old, p-old);
 		}
 		p += parse.tokenPtr->size;
+		length -= parse.tokenPtr->size;
 		code = Tcl_EvalTokensStandard(interp, parse.tokenPtr,
 		        parse.numTokens);
 		if (code == TCL_ERROR) {
@@ -2599,7 +2595,7 @@ Tcl_SubstObj(interp, objPtr, flags)
 		Tcl_ResetResult(interp);
 		old = p;
 	    } else {
-		p++;
+		p++; length--;
 	    }
 	    break;
 
@@ -2624,16 +2620,21 @@ Tcl_SubstObj(interp, objPtr, flags)
 		case TCL_CONTINUE:
 		    Tcl_ResetResult(interp);
 		    old = p = (p+1 + iPtr->termOffset + 1);
+		    length -= (iPtr->termOffset + 2);
 		}
 	    } else {
-		p++;
+		p++; length--;
 	    }
 	    break;
 	default:
-	    p++;
+	    p++; length--;
 	    break;
 	}
     }
+    if (p != old) {
+	Tcl_AppendToObj(resultObj, old, p-old);
+    }
+    return resultObj;
 
  errorResult:
     Tcl_DecrRefCount(resultObj);
diff --git a/tests/subst.test b/tests/subst.test
index c91145d..792420a 100644
--- a/tests/subst.test
+++ b/tests/subst.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: subst.test,v 1.13.2.1 2003/03/08 21:43:49 dgp Exp $
+# RCS: @(#) $Id: subst.test,v 1.13.2.2 2003/03/12 18:04:41 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -34,6 +34,10 @@ test subst-2.2 {simple strings} {
 test subst-2.3 {simple strings} {
     subst abcdefg
 } abcdefg
+test subst-2.4 {simple strings} {
+    # Tcl Bug 685106
+    subst [bytestring bar\x00soom]
+} [bytestring bar\x00soom]
 
 test subst-3.1 {backslash substitutions} {
     subst {\x\$x\[foo bar]\\}
@@ -216,10 +220,6 @@ test subst-11.6 {continue in a variable subst} {
     subst {foo $var([continue]) bar}
 } {foo  bar}
 
-test subst-bug-685106 {Tcl_SubstObj halts on NULL} {
-    subst [bytestring bar\x00soom]
-} [bytestring bar\x00soom]
-
 # cleanup
 ::tcltest::cleanupTests
 return