diff options
| -rw-r--r-- | ChangeLog | 14 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 30 | ||||
| -rw-r--r-- | tests/regexp.test | 25 | ||||
| -rw-r--r-- | win/tclWinPipe.c | 27 |
4 files changed, 85 insertions, 11 deletions
@@ -1,3 +1,17 @@ +2000-04-10 Eric Melski <ericm@scriptics.com> + + * win/tclWinPipe.c (TclpCreateTempFile): Added conversion of + contents string from UTF to native encoding [Bug: 4030]. + + * tests/regexp.test: Added tests for infinite looping in [regexp + -all]. + + * generic/tclCmdMZ.c: Fixed infinite loop bug with [regexp -all] + [Bug: 4981]. + + * tests/*.test: Changed all occurances of "namespace import + ::tcltest" to "namespace import -force ::tcltest" [Bug: 3948]. + 2000-04-10 Jeff Hobbs <hobbs@scriptics.com> * generic/tcl.h: removed specific typedef of Tcl_ThreadCreateProc diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 16b7522..cbb2f83 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.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: tclCmdMZ.c,v 1.25 2000/02/05 12:08:59 hobbs Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.26 2000/04/10 21:08:26 ericm Exp $ */ #include "tclInt.h" @@ -127,7 +127,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) Tcl_Obj *CONST objv[]; /* Argument objects. */ { int i, indices, match, about, offset, all, doinline, numMatchesSaved; - int cflags, eflags; + int cflags, eflags, stringLength; Tcl_RegExp regExpr; Tcl_Obj *objPtr, *resultPtr; Tcl_RegExpInfo info; @@ -274,6 +274,20 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) numMatchesSaved = (objc == 0) ? all : objc; } + /* + * Get the length of the string that we are matching against so + * we can do the termination test for -all matches. + */ + stringLength = Tcl_GetCharLength(objPtr); + + /* + * The following loop is to handle multiple matches within the + * same source string; each iteration handles one match. If "-all" + * hasn't been specified then the loop body only gets executed once. + * We terminate the loop when the starting offset is past the end of the + * string. + */ + while (1) { match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset /* offset */, numMatchesSaved, eflags); @@ -377,10 +391,20 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) /* * Adjust the offset to the character just after the last one * in the matchVar and increment all to count how many times - * we are making a match + * we are making a match. We always increment the offset by at least + * one to prevent endless looping (as in the case: + * regexp -all {a*} a). Otherwise, when we match the NULL string at + * the end of the input string, we will loop indefinately (because the + * length of the match is 0, so offset never changes). */ + if (info.matches[0].end == 0) { + offset++; + } offset += info.matches[0].end; all++; + if (offset >= stringLength) { + break; + } } /* diff --git a/tests/regexp.test b/tests/regexp.test index dfbfd38..e891b54 100644 --- a/tests/regexp.test +++ b/tests/regexp.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: regexp.test,v 1.12 2000/04/10 17:19:03 ericm Exp $ +# RCS: @(#) $Id: regexp.test,v 1.13 2000/04/10 21:08:27 ericm Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -503,6 +503,29 @@ test regexp-18.6 {regexp -all -inline} { test regexp-18.7 {regexp -all -inline} { list [catch {regexp -all -inline b abc match} msg] $msg } {1 {regexp match variables not allowed when using -inline}} +test regexp-18.8 {regexp -all} { + # This should not cause an infinite loop + regexp -all -inline {a*} a +} {a} +test regexp-18.9 {regexp -all} { + # Yes, the expected result is {a {}}. Here's why: + # Start at index 0; a* matches the "a" there then stops. + # Go to index 1; a* matches the lambda (or {}) there then stops. Recall + # that a* matches zero or more "a"'s; thus it matches the string "b", as + # there are zero or more "a"'s there. + # Go to index 2; this is past the end of the string, so stop. + regexp -all -inline {a*} ab +} {a {}} +test regexp-18.10 {regexp -all} { + # Yes, the expected result is {a {} a}. Here's why: + # Start at index 0; a* matches the "a" there then stops. + # Go to index 1; a* matches the lambda (or {}) there then stops. Recall + # that a* matches zero or more "a"'s; thus it matches the string "b", as + # there are zero or more "a"'s there. + # Go to index 2; a* matches the "a" there then stops. + # Go to index 3; this is past the end of the string, so stop. + regexp -all -inline {a*} aba +} {a {} a} # cleanup ::tcltest::cleanupTests diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 5c4b137..21f15c4 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinPipe.c,v 1.9 1999/12/09 14:44:11 hobbs Exp $ + * RCS: @(#) $Id: tclWinPipe.c,v 1.10 2000/04/10 21:08:27 ericm Exp $ */ #include "tclWinInt.h" @@ -692,6 +692,8 @@ TclpCreateTempFile(contents) CONST char *contents; /* String to write into temp file, or NULL. */ { WCHAR name[MAX_PATH]; + char *native; + Tcl_DString dstring; HANDLE handle; if (TempFileName(name) == 0) { @@ -712,27 +714,33 @@ TclpCreateTempFile(contents) if (contents != NULL) { DWORD result, length; CONST char *p; + + /* + * Convert the contents from UTF to native encoding + */ + native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring); - for (p = contents; *p != '\0'; p++) { + for (p = native; *p != '\0'; p++) { if (*p == '\n') { - length = p - contents; + length = p - native; if (length > 0) { - if (!WriteFile(handle, contents, length, &result, NULL)) { + if (!WriteFile(handle, native, length, &result, NULL)) { goto error; } } if (!WriteFile(handle, "\r\n", 2, &result, NULL)) { goto error; } - contents = p+1; + native = p+1; } } - length = p - contents; + length = p - native; if (length > 0) { - if (!WriteFile(handle, contents, length, &result, NULL)) { + if (!WriteFile(handle, native, length, &result, NULL)) { goto error; } } + Tcl_DStringFree(&dstring); if (SetFilePointer(handle, 0, NULL, FILE_BEGIN) == 0xFFFFFFFF) { goto error; } @@ -741,6 +749,11 @@ TclpCreateTempFile(contents) return TclWinMakeFile(handle); error: + /* Free the native representation of the contents if necessary */ + if (contents != NULL) { + Tcl_DStringFree(&dstring); + } + TclWinConvertError(GetLastError()); CloseHandle(handle); (*tclWinProcs->deleteFileProc)((TCHAR *) name); |