* 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].

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);