diff options
| -rw-r--r-- | ChangeLog | 4 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 31 | ||||
| -rw-r--r-- | tests/subst.test | 10 |
3 files changed, 25 insertions, 20 deletions
@@ -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 |