summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog4
-rw-r--r--generic/tclCmdMZ.c31
-rw-r--r--tests/subst.test10
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