Merge tip-468 branch

1 files changed, 66 insertions, 46 deletions

diff --git a/generic/tclScan.c b/generic/tclScan.c
index 5ea7e46..6a1311f 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -73,17 +73,17 @@ BuildCharSet(
     CharSet *cset,
     const char *format)		/* Points to first char of set. */
 {
-    Tcl_UniChar ch, start;
+    Tcl_UniChar ch = 0, start;
     int offset, nranges;
     const char *end;
 
     memset(cset, 0, sizeof(CharSet));
 
-    offset = Tcl_UtfToUniChar(format, &ch);
+    offset = TclUtfToUniChar(format, &ch);
     if (ch == '^') {
 	cset->exclude = 1;
 	format += offset;
-	offset = Tcl_UtfToUniChar(format, &ch);
+	offset = TclUtfToUniChar(format, &ch);
     }
     end = format + offset;
 
@@ -92,14 +92,14 @@ BuildCharSet(
      */
 
     if (ch == ']') {
-	end += Tcl_UtfToUniChar(end, &ch);
+	end += TclUtfToUniChar(end, &ch);
     }
     nranges = 0;
     while (ch != ']') {
 	if (ch == '-') {
 	    nranges++;
 	}
-	end += Tcl_UtfToUniChar(end, &ch);
+	end += TclUtfToUniChar(end, &ch);
     }
 
     cset->chars = ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
@@ -114,11 +114,11 @@ BuildCharSet(
      */
 
     cset->nchars = cset->nranges = 0;
-    format += Tcl_UtfToUniChar(format, &ch);
+    format += TclUtfToUniChar(format, &ch);
     start = ch;
     if (ch == ']' || ch == '-') {
 	cset->chars[cset->nchars++] = ch;
-	format += Tcl_UtfToUniChar(format, &ch);
+	format += TclUtfToUniChar(format, &ch);
     }
     while (ch != ']') {
 	if (*format == '-') {
@@ -139,7 +139,7 @@ BuildCharSet(
 		cset->chars[cset->nchars++] = start;
 		cset->chars[cset->nchars++] = ch;
 	    } else {
-		format += Tcl_UtfToUniChar(format, &ch);
+		format += TclUtfToUniChar(format, &ch);
 
 		/*
 		 * Check to see if the range is in reverse order.
@@ -157,7 +157,7 @@ BuildCharSet(
 	} else {
 	    cset->chars[cset->nchars++] = ch;
 	}
-	format += Tcl_UtfToUniChar(format, &ch);
+	format += TclUtfToUniChar(format, &ch);
     }
     return format;
 }
@@ -258,7 +258,7 @@ ValidateFormat(
 {
     int gotXpg, gotSequential, value, i, flags;
     char *end;
-    Tcl_UniChar ch;
+    Tcl_UniChar ch = 0;
     int objIndex, xpgSize, nspace = numVars;
     int *nassign = TclStackAlloc(interp, nspace * sizeof(int));
     char buf[TCL_UTF_MAX+1];
@@ -280,20 +280,20 @@ ValidateFormat(
     xpgSize = objIndex = gotXpg = gotSequential = 0;
 
     while (*format != '\0') {
-	format += Tcl_UtfToUniChar(format, &ch);
+	format += TclUtfToUniChar(format, &ch);
 
 	flags = 0;
 
 	if (ch != '%') {
 	    continue;
 	}
-	format += Tcl_UtfToUniChar(format, &ch);
+	format += TclUtfToUniChar(format, &ch);
 	if (ch == '%') {
 	    continue;
 	}
 	if (ch == '*') {
 	    flags |= SCAN_SUPPRESS;
-	    format += Tcl_UtfToUniChar(format, &ch);
+	    format += TclUtfToUniChar(format, &ch);
 	    goto xpgCheckDone;
 	}
 
@@ -309,7 +309,7 @@ ValidateFormat(
 		goto notXpg;
 	    }
 	    format = end+1;
-	    format += Tcl_UtfToUniChar(format, &ch);
+	    format += TclUtfToUniChar(format, &ch);
 	    gotXpg = 1;
 	    if (gotSequential) {
 		goto mixedXPG;
@@ -348,7 +348,7 @@ ValidateFormat(
 	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
 	    value = strtoul(format-1, (char **) &format, 10);	/* INTL: "C" locale. */
 	    flags |= SCAN_WIDTH;
-	    format += Tcl_UtfToUniChar(format, &ch);
+	    format += TclUtfToUniChar(format, &ch);
 	}
 
 	/*
@@ -360,13 +360,13 @@ ValidateFormat(
 	    if (*format == 'l') {
 		flags |= SCAN_BIG;
 		format += 1;
-		format += Tcl_UtfToUniChar(format, &ch);
+		format += TclUtfToUniChar(format, &ch);
 		break;
 	    }
 	case 'L':
 	    flags |= SCAN_LONGER;
 	case 'h':
-	    format += Tcl_UtfToUniChar(format, &ch);
+	    format += TclUtfToUniChar(format, &ch);
 	}
 
 	if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) {
@@ -428,24 +428,24 @@ ValidateFormat(
 	    if (*format == '\0') {
 		goto badSet;
 	    }
-	    format += Tcl_UtfToUniChar(format, &ch);
+	    format += TclUtfToUniChar(format, &ch);
 	    if (ch == '^') {
 		if (*format == '\0') {
 		    goto badSet;
 		}
-		format += Tcl_UtfToUniChar(format, &ch);
+		format += TclUtfToUniChar(format, &ch);
 	    }
 	    if (ch == ']') {
 		if (*format == '\0') {
 		    goto badSet;
 		}
-		format += Tcl_UtfToUniChar(format, &ch);
+		format += TclUtfToUniChar(format, &ch);
 	    }
 	    while (ch != ']') {
 		if (*format == '\0') {
 		    goto badSet;
 		}
-		format += Tcl_UtfToUniChar(format, &ch);
+		format += TclUtfToUniChar(format, &ch);
 	    }
 	    break;
 	badSet:
@@ -576,7 +576,7 @@ Tcl_ScanObjCmd(
     char op = 0;
     int width, underflow = 0;
     Tcl_WideInt wideValue;
-    Tcl_UniChar ch, sch;
+    Tcl_UniChar ch = 0, sch = 0;
     Tcl_Obj **objs = NULL, *objPtr = NULL;
     int flags;
     char buf[513];		/* Temporary buffer to hold scanned number
@@ -624,7 +624,7 @@ Tcl_ScanObjCmd(
     nconversions = 0;
     while (*format != '\0') {
 	int parseFlag = TCL_PARSE_NO_WHITESPACE;
-	format += Tcl_UtfToUniChar(format, &ch);
+	format += TclUtfToUniChar(format, &ch);
 
 	flags = 0;
 
@@ -633,13 +633,13 @@ Tcl_ScanObjCmd(
 	 */
 
 	if (Tcl_UniCharIsSpace(ch)) {
-	    offset = Tcl_UtfToUniChar(string, &sch);
+	    offset = TclUtfToUniChar(string, &sch);
 	    while (Tcl_UniCharIsSpace(sch)) {
 		if (*string == '\0') {
 		    goto done;
 		}
 		string += offset;
-		offset = Tcl_UtfToUniChar(string, &sch);
+		offset = TclUtfToUniChar(string, &sch);
 	    }
 	    continue;
 	}
@@ -650,14 +650,14 @@ Tcl_ScanObjCmd(
 		underflow = 1;
 		goto done;
 	    }
-	    string += Tcl_UtfToUniChar(string, &sch);
+	    string += TclUtfToUniChar(string, &sch);
 	    if (ch != sch) {
 		goto done;
 	    }
 	    continue;
 	}
 
-	format += Tcl_UtfToUniChar(format, &ch);
+	format += TclUtfToUniChar(format, &ch);
 	if (ch == '%') {
 	    goto literal;
 	}
@@ -669,13 +669,13 @@ Tcl_ScanObjCmd(
 
 	if (ch == '*') {
 	    flags |= SCAN_SUPPRESS;
-	    format += Tcl_UtfToUniChar(format, &ch);
+	    format += TclUtfToUniChar(format, &ch);
 	} else if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
 	    char *formatEnd;
 	    value = strtoul(format-1, &formatEnd, 10);/* INTL: "C" locale. */
 	    if (*formatEnd == '$') {
 		format = formatEnd+1;
-		format += Tcl_UtfToUniChar(format, &ch);
+		format += TclUtfToUniChar(format, &ch);
 		objIndex = (int) value - 1;
 	    }
 	}
@@ -686,7 +686,7 @@ Tcl_ScanObjCmd(
 
 	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
 	    width = (int) strtoul(format-1, (char **) &format, 10);/* INTL: "C" locale. */
-	    format += Tcl_UtfToUniChar(format, &ch);
+	    format += TclUtfToUniChar(format, &ch);
 	} else {
 	    width = 0;
 	}
@@ -700,7 +700,7 @@ Tcl_ScanObjCmd(
 	    if (*format == 'l') {
 		flags |= SCAN_BIG;
 		format += 1;
-		format += Tcl_UtfToUniChar(format, &ch);
+		format += TclUtfToUniChar(format, &ch);
 		break;
 	    }
 	case 'L':
@@ -709,7 +709,7 @@ Tcl_ScanObjCmd(
 	     * Fall through so we skip to the next character.
 	     */
 	case 'h':
-	    format += Tcl_UtfToUniChar(format, &ch);
+	    format += TclUtfToUniChar(format, &ch);
 	}
 
 	/*
@@ -793,7 +793,7 @@ Tcl_ScanObjCmd(
 
 	if (!(flags & SCAN_NOSKIP)) {
 	    while (*string != '\0') {
-		offset = Tcl_UtfToUniChar(string, &sch);
+		offset = TclUtfToUniChar(string, &sch);
 		if (!Tcl_UniCharIsSpace(sch)) {
 		    break;
 		}
@@ -820,7 +820,7 @@ Tcl_ScanObjCmd(
 	    }
 	    end = string;
 	    while (*end != '\0') {
-		offset = Tcl_UtfToUniChar(end, &sch);
+		offset = TclUtfToUniChar(end, &sch);
 		if (Tcl_UniCharIsSpace(sch)) {
 		    break;
 		}
@@ -848,7 +848,7 @@ Tcl_ScanObjCmd(
 
 	    format = BuildCharSet(&cset, format);
 	    while (*end != '\0') {
-		offset = Tcl_UtfToUniChar(end, &sch);
+		offset = TclUtfToUniChar(end, &sch);
 		if (!CharInSet(&cset, (int)sch)) {
 		    break;
 		}
@@ -879,9 +879,17 @@ Tcl_ScanObjCmd(
 	     * Scan a single Unicode character.
 	     */
 
-	    string += Tcl_UtfToUniChar(string, &sch);
+	    offset = TclUtfToUniChar(string, &sch);
+	    i = (int)sch;
+#if TCL_UTF_MAX == 4
+	    if (!offset) {
+		offset = TclUtfToUniChar(string, &sch);
+		i = (((i<<10) & 0x0FFC00) + 0x10000) + (sch & 0x3FF);
+	    }
+#endif
+	    string += offset;
 	    if (!(flags & SCAN_SUPPRESS)) {
-		objPtr = Tcl_NewIntObj((int)sch);
+		objPtr = Tcl_NewIntObj(i);
 		Tcl_IncrRefCount(objPtr);
 		CLANG_ASSERT(objs);
 		objs[objIndex++] = objPtr;
@@ -918,26 +926,38 @@ Tcl_ScanObjCmd(
 	    }
 	    if (flags & SCAN_LONGER) {
 		if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
-		    wideValue = ~(Tcl_WideUInt)0 >> 1;	/* WIDE_MAX */
+		    wideValue = WIDE_MAX;
 		    if (TclGetString(objPtr)[0] == '-') {
-			wideValue++;	/* WIDE_MAX + 1 = WIDE_MIN */
+			wideValue = WIDE_MIN;
 		    }
 		}
 		if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
-		    sprintf(buf, "%" TCL_LL_MODIFIER "u",
-			    (Tcl_WideUInt)wideValue);
+		    sprintf(buf, "%" TCL_LL_MODIFIER "u", wideValue);
 		    Tcl_SetStringObj(objPtr, buf, -1);
 		} else {
-		    Tcl_SetWideIntObj(objPtr, wideValue);
+		    TclSetIntObj(objPtr, wideValue);
 		}
 	    } else if (flags & SCAN_BIG) {
 		if (flags & SCAN_UNSIGNED) {
 		    mp_int big;
-		    if ((Tcl_GetBignumFromObj(interp, objPtr, &big) != TCL_OK)
-			    || (mp_cmp_d(&big, 0) == MP_LT)) {
+		    int code = Tcl_GetBignumFromObj(interp, objPtr, &big);
+
+		    if (code == TCL_OK) {
+			if (mp_isneg(&big)) {
+			    code = TCL_ERROR;
+			}
+			mp_clear(&big);
+		    }
+
+		    if (code == TCL_ERROR) {
+			if (objs != NULL) {
+			    ckfree(objs);
+			}
+			Tcl_DecrRefCount(objPtr);
 			Tcl_SetObjResult(interp, Tcl_NewStringObj(
 				"unsigned bignum scans are invalid", -1));
-			Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
+			Tcl_SetErrorCode(interp, "TCL", "FORMAT",
+				"BADUNSIGNED",NULL);
 			return TCL_ERROR;
 		    }
 		}
@@ -953,7 +973,7 @@ Tcl_ScanObjCmd(
 		    sprintf(buf, "%lu", value);	/* INTL: ISO digit */
 		    Tcl_SetStringObj(objPtr, buf, -1);
 		} else {
-		    Tcl_SetLongObj(objPtr, value);
+		    TclSetIntObj(objPtr, value);
 		}
 	    }
 	    objs[objIndex++] = objPtr;