summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog14
-rw-r--r--generic/tclCmdMZ.c30
-rw-r--r--tests/regexp.test25
-rw-r--r--win/tclWinPipe.c27
4 files changed, 85 insertions, 11 deletions
diff --git a/ChangeLog b/ChangeLog
index dee5c5e..b5cf352 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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);