Updated as best I can without adding additional Unicode handling functions

from 8.4 (from where most of the real fixes stem.)

2 files changed, 55 insertions, 41 deletions

diff --git a/ChangeLog b/ChangeLog
index 31b8f50..fc7b3d4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2001-10-10  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	* generic/tclCmdMZ.c: Removed pointless #include and SCAN_* flags.
+	(Tcl_RegexpObjCmd): Fixed match area offset bug.
+	(Tcl_StringObjCmd): Fixed STR_INDEX and STR_REPEAT, and tidied up
+	STR_IS and STR_LENGTH.
+
 2001-10-09  Miguel Sofer  <msofer@users.sourceforge.net>
 	
 	* generic/tclObj.c: removed duplicate definition of tclObjsAlloced
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index f8798c5..426a2d5 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -8,36 +8,19 @@
  *
  * Copyright (c) 1987-1993 The Regents of the University of California.
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
- * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 1998-2000 Scriptics Corporation.
  *
  * 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.26.2.2 2001/08/07 00:51:12 hobbs Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.26.2.3 2001/10/10 15:34:25 dkf Exp $
  */
 
 #include "tclInt.h"
 #include "tclPort.h"
-#include "tclCompile.h"
 #include "tclRegexp.h"
 
 /*
- * Flag values used by Tcl_ScanObjCmd.
- */
-
-#define SCAN_NOSKIP	0x1		  /* Don't skip blanks. */
-#define SCAN_SUPPRESS	0x2		  /* Suppress assignment. */
-#define SCAN_UNSIGNED	0x4		  /* Read an unsigned value. */
-#define SCAN_WIDTH	0x8		  /* A width value was supplied. */
-
-#define SCAN_SIGNOK	0x10		  /* A +/- character is allowed. */
-#define SCAN_NODIGITS	0x20		  /* No digits have been scanned. */
-#define SCAN_NOZERO	0x40		  /* No zero digits have been scanned. */
-#define SCAN_XOK	0x80		  /* An 'x' is allowed. */
-#define SCAN_PTOK	0x100		  /* Decimal point is allowed. */
-#define SCAN_EXPOK	0x200		  /* An exponent is allowed. */
-
-/*
  * Structure used to hold information about variable traces:
  */
 
@@ -338,7 +321,11 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
 		int start, end;
 		Tcl_Obj *objs[2];
 
-		if (i <= info.nsubs) {
+		/*
+		 * Only adjust the match area if there was a match for
+		 * that area.  (Scriptics Bug 4391/SF Bug #219232)
+		 */
+		if (i <= info.nsubs && info.matches[i].start >= 0) {
 		    start = offset + info.matches[i].start;
 		    end   = offset + info.matches[i].end;
 
@@ -1211,9 +1198,6 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 	    break;
 	}
 	case STR_INDEX: {
-	    char buf[TCL_UTF_MAX];
-	    Tcl_UniChar unichar;
-
 	    if (objc != 4) {
 	        Tcl_WrongNumArgs(interp, 2, objv, "string charIndex");
 		return TCL_ERROR;
@@ -1227,7 +1211,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 	     */
 
 	    if (objv[2]->typePtr == &tclByteArrayType) {
-		string1 = (char *)Tcl_GetByteArrayFromObj(objv[2], &length1);
+		string1 = (char *) Tcl_GetByteArrayFromObj(objv[2], &length1);
 
 		if (TclGetIntForIndex(interp, objv[3], length1 - 1,
 			&index) != TCL_OK) {
@@ -1238,23 +1222,22 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 			    (unsigned char *)(&string1[index]), 1);
 		}
 	    } else {
-		string1 = Tcl_GetStringFromObj(objv[2], &length1);
-
 		/*
-		 * convert to Unicode internal rep to calulate what
-		 * 'end' really means.
+		 * Get Unicode char length to calulate what 'end' means.
 		 */
+		length1 = Tcl_GetCharLength(objv[2]);
 
-		length2 = Tcl_GetCharLength(objv[2]);
-
-		if (TclGetIntForIndex(interp, objv[3], length2 - 1,
+		if (TclGetIntForIndex(interp, objv[3], length1 - 1,
 			&index) != TCL_OK) {
 		    return TCL_ERROR;
 		}
-		if ((index >= 0) && (index < length2)) {
-		    unichar = Tcl_GetUniChar(objv[2], index);
-		    length2 = Tcl_UniCharToUtf((int)unichar, buf);
-		    Tcl_SetStringObj(resultPtr, buf, length2);
+		if ((index >= 0) && (index < length1)) {
+		    char buf[TCL_UTF_MAX];
+		    Tcl_UniChar ch;
+
+		    ch      = Tcl_GetUniChar(objv[2], index);
+		    length1 = Tcl_UniCharToUtf(ch, buf);
+		    Tcl_SetStringObj(resultPtr, buf, length1);
 		}
 	    }
 	    break;
@@ -1302,7 +1285,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 			strncmp(string2, "-strict", (size_t) length2) == 0) {
 			strict = 1;
 		    } else if ((length2 > 1) &&
-			       strncmp(string2, "-failindex", (size_t) length2) == 0) {
+			    strncmp(string2, "-failindex",
+				    (size_t) length2) == 0) {
 			if (i+1 >= objc-1) {
 			    Tcl_WrongNumArgs(interp, 3, objv,
 					     "?-strict? ?-failindex var? str");
@@ -1619,7 +1603,6 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 
 	    if ((enum options) index == STR_BYTELENGTH) {
 		(void) Tcl_GetStringFromObj(objv[2], &length1);
-		Tcl_SetIntObj(resultPtr, length1);
 	    } else {
 		/*
 		 * If we have a ByteArray object, avoid recomputing the
@@ -1630,12 +1613,11 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 
 		if (objv[2]->typePtr == &tclByteArrayType) {
 		    (void) Tcl_GetByteArrayFromObj(objv[2], &length1);
-		    Tcl_SetIntObj(resultPtr, length1);
 		} else {
-		    Tcl_SetIntObj(resultPtr,
-			    Tcl_GetCharLength(objv[2]));
+		    length1 = Tcl_GetCharLength(objv[2]);
 		}
 	    }
+	    Tcl_SetIntObj(resultPtr, length1);
 	    break;
 	}
 	case STR_MAP: {
@@ -1849,11 +1831,36 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 		return TCL_ERROR;
 	    }
 
+	    if (count == 1) {
+		Tcl_SetObjResult(interp, objv[2]);
+	    } else if (count > 1) {
 	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
 	    if (length1 > 0) {
+		    /*
+		     * Only build up a string that has data.  Instead of
+		     * building it up with repeated appends, we just allocate
+		     * the necessary space once and copy the string value in.
+		     */
+		    length2		= length1 * count;
+		    /*
+		     * Include space for the NULL
+		     */
+		    string2		= (char *) ckalloc((size_t) length2+1);
 		for (index = 0; index < count; index++) {
-		    Tcl_AppendToObj(resultPtr, string1, length1);
+			memcpy(string2 + (length1 * index), string1,
+				(size_t) length1);
 		}
+		    string2[length2]	= '\0';
+		    /*
+		     * We have to directly assign this instead of using
+		     * Tcl_SetStringObj (and indirectly TclInitStringRep)
+		     * because that makes another copy of the data.
+		     */
+		    resultPtr		= Tcl_NewObj();
+		    resultPtr->bytes	= string2;
+		    resultPtr->length	= length2;
+		    Tcl_SetObjResult(interp, resultPtr);
+	    }
 	    }
 	    break;
 	}