Merge commit '29ccecd87709feda60d191f6aaba324ccad91f55' as 'tcl8.6'

1 files changed, 1079 insertions, 0 deletions

diff --git a/tcl8.6/generic/tclScan.c b/tcl8.6/generic/tclScan.c
new file mode 100644
index 0000000..17069eb
--- /dev/null
+++ b/tcl8.6/generic/tclScan.c
@@ -0,0 +1,1079 @@
+/*
+ * tclScan.c --
+ *
+ *	This file contains the implementation of the "scan" command.
+ *
+ * Copyright (c) 1998 by Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.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_LONGER	0x400		/* Asked for a wide value. */
+#define SCAN_BIG	0x800		/* Asked for a bignum value. */
+
+/*
+ * The following structure contains the information associated with a
+ * character set.
+ */
+
+typedef struct CharSet {
+    int exclude;		/* 1 if this is an exclusion set. */
+    int nchars;
+    Tcl_UniChar *chars;
+    int nranges;
+    struct Range {
+	Tcl_UniChar start;
+	Tcl_UniChar end;
+    } *ranges;
+} CharSet;
+
+/*
+ * Declarations for functions used only in this file.
+ */
+
+static const char *	BuildCharSet(CharSet *cset, const char *format);
+static int		CharInSet(CharSet *cset, int ch);
+static void		ReleaseCharSet(CharSet *cset);
+static int		ValidateFormat(Tcl_Interp *interp, const char *format,
+			    int numVars, int *totalVars);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BuildCharSet --
+ *
+ *	This function examines a character set format specification and builds
+ *	a CharSet containing the individual characters and character ranges
+ *	specified.
+ *
+ * Results:
+ *	Returns the next format position.
+ *
+ * Side effects:
+ *	Initializes the charset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static const char *
+BuildCharSet(
+    CharSet *cset,
+    const char *format)		/* Points to first char of set. */
+{
+    Tcl_UniChar ch, start;
+    int offset, nranges;
+    const char *end;
+
+    memset(cset, 0, sizeof(CharSet));
+
+    offset = TclUtfToUniChar(format, &ch);
+    if (ch == '^') {
+	cset->exclude = 1;
+	format += offset;
+	offset = TclUtfToUniChar(format, &ch);
+    }
+    end = format + offset;
+
+    /*
+     * Find the close bracket so we can overallocate the set.
+     */
+
+    if (ch == ']') {
+	end += TclUtfToUniChar(end, &ch);
+    }
+    nranges = 0;
+    while (ch != ']') {
+	if (ch == '-') {
+	    nranges++;
+	}
+	end += TclUtfToUniChar(end, &ch);
+    }
+
+    cset->chars = ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
+    if (nranges > 0) {
+	cset->ranges = ckalloc(sizeof(struct Range) * nranges);
+    } else {
+	cset->ranges = NULL;
+    }
+
+    /*
+     * Now build the character set.
+     */
+
+    cset->nchars = cset->nranges = 0;
+    format += TclUtfToUniChar(format, &ch);
+    start = ch;
+    if (ch == ']' || ch == '-') {
+	cset->chars[cset->nchars++] = ch;
+	format += TclUtfToUniChar(format, &ch);
+    }
+    while (ch != ']') {
+	if (*format == '-') {
+	    /*
+	     * This may be the first character of a range, so don't add it
+	     * yet.
+	     */
+
+	    start = ch;
+	} else if (ch == '-') {
+	    /*
+	     * Check to see if this is the last character in the set, in which
+	     * case it is not a range and we should add the previous character
+	     * as well as the dash.
+	     */
+
+	    if (*format == ']') {
+		cset->chars[cset->nchars++] = start;
+		cset->chars[cset->nchars++] = ch;
+	    } else {
+		format += TclUtfToUniChar(format, &ch);
+
+		/*
+		 * Check to see if the range is in reverse order.
+		 */
+
+		if (start < ch) {
+		    cset->ranges[cset->nranges].start = start;
+		    cset->ranges[cset->nranges].end = ch;
+		} else {
+		    cset->ranges[cset->nranges].start = ch;
+		    cset->ranges[cset->nranges].end = start;
+		}
+		cset->nranges++;
+	    }
+	} else {
+	    cset->chars[cset->nchars++] = ch;
+	}
+	format += TclUtfToUniChar(format, &ch);
+    }
+    return format;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CharInSet --
+ *
+ *	Check to see if a character matches the given set.
+ *
+ * Results:
+ *	Returns non-zero if the character matches the given set.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CharInSet(
+    CharSet *cset,
+    int c)			/* Character to test, passed as int because of
+				 * non-ANSI prototypes. */
+{
+    Tcl_UniChar ch = (Tcl_UniChar) c;
+    int i, match = 0;
+
+    for (i = 0; i < cset->nchars; i++) {
+	if (cset->chars[i] == ch) {
+	    match = 1;
+	    break;
+	}
+    }
+    if (!match) {
+	for (i = 0; i < cset->nranges; i++) {
+	    if ((cset->ranges[i].start <= ch) && (ch <= cset->ranges[i].end)) {
+		match = 1;
+		break;
+	    }
+	}
+    }
+    return (cset->exclude ? !match : match);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReleaseCharSet --
+ *
+ *	Free the storage associated with a character set.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReleaseCharSet(
+    CharSet *cset)
+{
+    ckfree(cset->chars);
+    if (cset->ranges) {
+	ckfree(cset->ranges);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ValidateFormat --
+ *
+ *	Parse the format string and verify that it is properly formed and that
+ *	there are exactly enough variables on the command line.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	May place an error in the interpreter result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ValidateFormat(
+    Tcl_Interp *interp,		/* Current interpreter. */
+    const char *format,		/* The format string. */
+    int numVars,		/* The number of variables passed to the scan
+				 * command. */
+    int *totalSubs)		/* The number of variables that will be
+				 * required. */
+{
+    int gotXpg, gotSequential, value, i, flags;
+    char *end;
+    Tcl_UniChar ch;
+    int objIndex, xpgSize, nspace = numVars;
+    int *nassign = TclStackAlloc(interp, nspace * sizeof(int));
+    char buf[TCL_UTF_MAX+1];
+    Tcl_Obj *errorMsg;		/* Place to build an error messages. Note that
+				 * these are messy operations because we do
+				 * not want to use the formatting engine;
+				 * we're inside there! */
+
+    /*
+     * Initialize an array that records the number of times a variable is
+     * assigned to by the format string. We use this to detect if a variable
+     * is multiply assigned or left unassigned.
+     */
+
+    for (i = 0; i < nspace; i++) {
+	nassign[i] = 0;
+    }
+
+    xpgSize = objIndex = gotXpg = gotSequential = 0;
+
+    while (*format != '\0') {
+	format += TclUtfToUniChar(format, &ch);
+
+	flags = 0;
+
+	if (ch != '%') {
+	    continue;
+	}
+	format += TclUtfToUniChar(format, &ch);
+	if (ch == '%') {
+	    continue;
+	}
+	if (ch == '*') {
+	    flags |= SCAN_SUPPRESS;
+	    format += TclUtfToUniChar(format, &ch);
+	    goto xpgCheckDone;
+	}
+
+	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
+	    /*
+	     * Check for an XPG3-style %n$ specification. Note: there must
+	     * not be a mixture of XPG3 specs and non-XPG3 specs in the same
+	     * format string.
+	     */
+
+	    value = strtoul(format-1, &end, 10);	/* INTL: "C" locale. */
+	    if (*end != '$') {
+		goto notXpg;
+	    }
+	    format = end+1;
+	    format += TclUtfToUniChar(format, &ch);
+	    gotXpg = 1;
+	    if (gotSequential) {
+		goto mixedXPG;
+	    }
+	    objIndex = value - 1;
+	    if ((objIndex < 0) || (numVars && (objIndex >= numVars))) {
+		goto badIndex;
+	    } else if (numVars == 0) {
+		/*
+		 * In the case where no vars are specified, the user can
+		 * specify %9999$ legally, so we have to consider special
+		 * rules for growing the assign array. 'value' is guaranteed
+		 * to be > 0.
+		 */
+		xpgSize = (xpgSize > value) ? xpgSize : value;
+	    }
+	    goto xpgCheckDone;
+	}
+
+    notXpg:
+	gotSequential = 1;
+	if (gotXpg) {
+	mixedXPG:
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "cannot mix \"%\" and \"%n$\" conversion specifiers",
+		    -1));
+	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "MIXEDSPECTYPES", NULL);
+	    goto error;
+	}
+
+    xpgCheckDone:
+	/*
+	 * Parse any width specifier.
+	 */
+
+	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
+	    value = strtoul(format-1, (char **) &format, 10);	/* INTL: "C" locale. */
+	    flags |= SCAN_WIDTH;
+	    format += TclUtfToUniChar(format, &ch);
+	}
+
+	/*
+	 * Handle any size specifier.
+	 */
+
+	switch (ch) {
+	case 'l':
+	    if (*format == 'l') {
+		flags |= SCAN_BIG;
+		format += 1;
+		format += TclUtfToUniChar(format, &ch);
+		break;
+	    }
+	case 'L':
+	    flags |= SCAN_LONGER;
+	case 'h':
+	    format += TclUtfToUniChar(format, &ch);
+	}
+
+	if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) {
+	    goto badIndex;
+	}
+
+	/*
+	 * Handle the various field types.
+	 */
+
+	switch (ch) {
+	case 'c':
+	    if (flags & SCAN_WIDTH) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"field width may not be specified in %c conversion",
+			-1));
+		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", NULL);
+		goto error;
+	    }
+	    /*
+	     * Fall through!
+	     */
+	case 'n':
+	case 's':
+	    if (flags & (SCAN_LONGER|SCAN_BIG)) {
+	    invalidFieldSize:
+		buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
+		errorMsg = Tcl_NewStringObj(
+			"field size modifier may not be specified in %", -1);
+		Tcl_AppendToObj(errorMsg, buf, -1);
+		Tcl_AppendToObj(errorMsg, " conversion", -1);
+		Tcl_SetObjResult(interp, errorMsg);
+		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADSIZE", NULL);
+		goto error;
+	    }
+	    /*
+	     * Fall through!
+	     */
+	case 'd':
+	case 'e':
+	case 'E':
+	case 'f':
+	case 'g':
+	case 'G':
+	case 'i':
+	case 'o':
+	case 'x':
+	case 'X':
+	case 'b':
+	    break;
+	case 'u':
+	    if (flags & SCAN_BIG) {
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"unsigned bignum scans are invalid", -1));
+		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
+		goto error;
+	    }
+	    break;
+	    /*
+	     * Bracket terms need special checking
+	     */
+	case '[':
+	    if (flags & (SCAN_LONGER|SCAN_BIG)) {
+		goto invalidFieldSize;
+	    }
+	    if (*format == '\0') {
+		goto badSet;
+	    }
+	    format += TclUtfToUniChar(format, &ch);
+	    if (ch == '^') {
+		if (*format == '\0') {
+		    goto badSet;
+		}
+		format += TclUtfToUniChar(format, &ch);
+	    }
+	    if (ch == ']') {
+		if (*format == '\0') {
+		    goto badSet;
+		}
+		format += TclUtfToUniChar(format, &ch);
+	    }
+	    while (ch != ']') {
+		if (*format == '\0') {
+		    goto badSet;
+		}
+		format += TclUtfToUniChar(format, &ch);
+	    }
+	    break;
+	badSet:
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "unmatched [ in format string", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", NULL);
+	    goto error;
+	default:
+	    buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
+	    errorMsg = Tcl_NewStringObj(
+		    "bad scan conversion character \"", -1);
+	    Tcl_AppendToObj(errorMsg, buf, -1);
+	    Tcl_AppendToObj(errorMsg, "\"", -1);
+	    Tcl_SetObjResult(interp, errorMsg);
+	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL);
+	    goto error;
+	}
+	if (!(flags & SCAN_SUPPRESS)) {
+	    if (objIndex >= nspace) {
+		/*
+		 * Expand the nassign buffer. If we are using XPG specifiers,
+		 * make sure that we grow to a large enough size. xpgSize is
+		 * guaranteed to be at least one larger than objIndex.
+		 */
+
+		value = nspace;
+		if (xpgSize) {
+		    nspace = xpgSize;
+		} else {
+		    nspace += 16;	/* formerly STATIC_LIST_SIZE */
+		}
+		nassign = TclStackRealloc(interp, nassign,
+			nspace * sizeof(int));
+		for (i = value; i < nspace; i++) {
+		    nassign[i] = 0;
+		}
+	    }
+	    nassign[objIndex]++;
+	    objIndex++;
+	}
+    }
+
+    /*
+     * Verify that all of the variable were assigned exactly once.
+     */
+
+    if (numVars == 0) {
+	if (xpgSize) {
+	    numVars = xpgSize;
+	} else {
+	    numVars = objIndex;
+	}
+    }
+    if (totalSubs) {
+	*totalSubs = numVars;
+    }
+    for (i = 0; i < numVars; i++) {
+	if (nassign[i] > 1) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "variable is assigned by multiple \"%n$\" conversion specifiers",
+		    -1));
+	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "POLYASSIGNED", NULL);
+	    goto error;
+	} else if (!xpgSize && (nassign[i] == 0)) {
+	    /*
+	     * If the space is empty, and xpgSize is 0 (means XPG wasn't used,
+	     * and/or numVars != 0), then too many vars were given
+	     */
+
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "variable is not assigned by any conversion specifiers",
+		    -1));
+	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "UNASSIGNED", NULL);
+	    goto error;
+	}
+    }
+
+    TclStackFree(interp, nassign);
+    return TCL_OK;
+
+  badIndex:
+    if (gotXpg) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"\"%n$\" argument index out of range", -1));
+	Tcl_SetErrorCode(interp, "TCL", "FORMAT", "INDEXRANGE", NULL);
+    } else {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"different numbers of variable names and field specifiers",
+		-1));
+	Tcl_SetErrorCode(interp, "TCL", "FORMAT", "FIELDVARMISMATCH", NULL);
+    }
+
+  error:
+    TclStackFree(interp, nassign);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ScanObjCmd --
+ *
+ *	This function is invoked to process the "scan" Tcl command. See the
+ *	user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_ScanObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    const char *format;
+    int numVars, nconversions, totalVars = -1;
+    int objIndex, offset, i, result, code;
+    long value;
+    const char *string, *end, *baseString;
+    char op = 0;
+    int width, underflow = 0;
+    Tcl_WideInt wideValue;
+    Tcl_UniChar ch, sch;
+    Tcl_Obj **objs = NULL, *objPtr = NULL;
+    int flags;
+    char buf[513];		/* Temporary buffer to hold scanned number
+				 * strings before they are passed to
+				 * strtoul. */
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"string format ?varName ...?");
+	return TCL_ERROR;
+    }
+
+    format = Tcl_GetString(objv[2]);
+    numVars = objc-3;
+
+    /*
+     * Check for errors in the format string.
+     */
+
+    if (ValidateFormat(interp, format, numVars, &totalVars) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Allocate space for the result objects.
+     */
+
+    if (totalVars > 0) {
+	objs = ckalloc(sizeof(Tcl_Obj *) * totalVars);
+	for (i = 0; i < totalVars; i++) {
+	    objs[i] = NULL;
+	}
+    }
+
+    string = Tcl_GetString(objv[1]);
+    baseString = string;
+
+    /*
+     * Iterate over the format string filling in the result objects until we
+     * reach the end of input, the end of the format string, or there is a
+     * mismatch.
+     */
+
+    objIndex = 0;
+    nconversions = 0;
+    while (*format != '\0') {
+	int parseFlag = TCL_PARSE_NO_WHITESPACE;
+	format += TclUtfToUniChar(format, &ch);
+
+	flags = 0;
+
+	/*
+	 * If we see whitespace in the format, skip whitespace in the string.
+	 */
+
+	if (Tcl_UniCharIsSpace(ch)) {
+	    offset = TclUtfToUniChar(string, &sch);
+	    while (Tcl_UniCharIsSpace(sch)) {
+		if (*string == '\0') {
+		    goto done;
+		}
+		string += offset;
+		offset = TclUtfToUniChar(string, &sch);
+	    }
+	    continue;
+	}
+
+	if (ch != '%') {
+	literal:
+	    if (*string == '\0') {
+		underflow = 1;
+		goto done;
+	    }
+	    string += TclUtfToUniChar(string, &sch);
+	    if (ch != sch) {
+		goto done;
+	    }
+	    continue;
+	}
+
+	format += TclUtfToUniChar(format, &ch);
+	if (ch == '%') {
+	    goto literal;
+	}
+
+	/*
+	 * Check for assignment suppression ('*') or an XPG3-style assignment
+	 * ('%n$').
+	 */
+
+	if (ch == '*') {
+	    flags |= SCAN_SUPPRESS;
+	    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 += TclUtfToUniChar(format, &ch);
+		objIndex = (int) value - 1;
+	    }
+	}
+
+	/*
+	 * Parse any width specifier.
+	 */
+
+	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
+	    width = (int) strtoul(format-1, (char **) &format, 10);/* INTL: "C" locale. */
+	    format += TclUtfToUniChar(format, &ch);
+	} else {
+	    width = 0;
+	}
+
+	/*
+	 * Handle any size specifier.
+	 */
+
+	switch (ch) {
+	case 'l':
+	    if (*format == 'l') {
+		flags |= SCAN_BIG;
+		format += 1;
+		format += TclUtfToUniChar(format, &ch);
+		break;
+	    }
+	case 'L':
+	    flags |= SCAN_LONGER;
+	    /*
+	     * Fall through so we skip to the next character.
+	     */
+	case 'h':
+	    format += TclUtfToUniChar(format, &ch);
+	}
+
+	/*
+	 * Handle the various field types.
+	 */
+
+	switch (ch) {
+	case 'n':
+	    if (!(flags & SCAN_SUPPRESS)) {
+		objPtr = Tcl_NewIntObj(string - baseString);
+		Tcl_IncrRefCount(objPtr);
+		CLANG_ASSERT(objs);
+		objs[objIndex++] = objPtr;
+	    }
+	    nconversions++;
+	    continue;
+
+	case 'd':
+	    op = 'i';
+	    parseFlag |= TCL_PARSE_DECIMAL_ONLY;
+	    break;
+	case 'i':
+	    op = 'i';
+	    parseFlag |= TCL_PARSE_SCAN_PREFIXES;
+	    break;
+	case 'o':
+	    op = 'i';
+	    parseFlag |= TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES;
+	    break;
+	case 'x':
+	case 'X':
+	    op = 'i';
+	    parseFlag |= TCL_PARSE_HEXADECIMAL_ONLY;
+	    break;
+	case 'b':
+	    op = 'i';
+	    parseFlag |= TCL_PARSE_BINARY_ONLY;
+	    break;
+	case 'u':
+	    op = 'i';
+	    parseFlag |= TCL_PARSE_DECIMAL_ONLY;
+	    flags |= SCAN_UNSIGNED;
+	    break;
+
+	case 'f':
+	case 'e':
+	case 'E':
+	case 'g':
+	case 'G':
+	    op = 'f';
+	    break;
+
+	case 's':
+	    op = 's';
+	    break;
+
+	case 'c':
+	    op = 'c';
+	    flags |= SCAN_NOSKIP;
+	    break;
+	case '[':
+	    op = '[';
+	    flags |= SCAN_NOSKIP;
+	    break;
+	}
+
+	/*
+	 * At this point, we will need additional characters from the string
+	 * to proceed.
+	 */
+
+	if (*string == '\0') {
+	    underflow = 1;
+	    goto done;
+	}
+
+	/*
+	 * Skip any leading whitespace at the beginning of a field unless the
+	 * format suppresses this behavior.
+	 */
+
+	if (!(flags & SCAN_NOSKIP)) {
+	    while (*string != '\0') {
+		offset = TclUtfToUniChar(string, &sch);
+		if (!Tcl_UniCharIsSpace(sch)) {
+		    break;
+		}
+		string += offset;
+	    }
+	    if (*string == '\0') {
+		underflow = 1;
+		goto done;
+	    }
+	}
+
+	/*
+	 * Perform the requested scanning operation.
+	 */
+
+	switch (op) {
+	case 's':
+	    /*
+	     * Scan a string up to width characters or whitespace.
+	     */
+
+	    if (width == 0) {
+		width = ~0;
+	    }
+	    end = string;
+	    while (*end != '\0') {
+		offset = TclUtfToUniChar(end, &sch);
+		if (Tcl_UniCharIsSpace(sch)) {
+		    break;
+		}
+		end += offset;
+		if (--width == 0) {
+		    break;
+		}
+	    }
+	    if (!(flags & SCAN_SUPPRESS)) {
+		objPtr = Tcl_NewStringObj(string, end-string);
+		Tcl_IncrRefCount(objPtr);
+		CLANG_ASSERT(objs);
+		objs[objIndex++] = objPtr;
+	    }
+	    string = end;
+	    break;
+
+	case '[': {
+	    CharSet cset;
+
+	    if (width == 0) {
+		width = ~0;
+	    }
+	    end = string;
+
+	    format = BuildCharSet(&cset, format);
+	    while (*end != '\0') {
+		offset = TclUtfToUniChar(end, &sch);
+		if (!CharInSet(&cset, (int)sch)) {
+		    break;
+		}
+		end += offset;
+		if (--width == 0) {
+		    break;
+		}
+	    }
+	    ReleaseCharSet(&cset);
+
+	    if (string == end) {
+		/*
+		 * Nothing matched the range, stop processing.
+		 */
+		goto done;
+	    }
+	    if (!(flags & SCAN_SUPPRESS)) {
+		objPtr = Tcl_NewStringObj(string, end-string);
+		Tcl_IncrRefCount(objPtr);
+		objs[objIndex++] = objPtr;
+	    }
+	    string = end;
+
+	    break;
+	}
+	case 'c':
+	    /*
+	     * Scan a single Unicode character.
+	     */
+
+	    string += TclUtfToUniChar(string, &sch);
+	    if (!(flags & SCAN_SUPPRESS)) {
+		objPtr = Tcl_NewIntObj((int)sch);
+		Tcl_IncrRefCount(objPtr);
+		CLANG_ASSERT(objs);
+		objs[objIndex++] = objPtr;
+	    }
+	    break;
+
+	case 'i':
+	    /*
+	     * Scan an unsigned or signed integer.
+	     */
+	    objPtr = Tcl_NewLongObj(0);
+	    Tcl_IncrRefCount(objPtr);
+	    if (width == 0) {
+		width = ~0;
+	    }
+	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
+		    &end, TCL_PARSE_INTEGER_ONLY | parseFlag)) {
+		Tcl_DecrRefCount(objPtr);
+		if (width < 0) {
+		    if (*end == '\0') {
+			underflow = 1;
+		    }
+		} else {
+		    if (end == string + width) {
+			underflow = 1;
+		    }
+		}
+		goto done;
+	    }
+	    string = end;
+	    if (flags & SCAN_SUPPRESS) {
+		Tcl_DecrRefCount(objPtr);
+		break;
+	    }
+	    if (flags & SCAN_LONGER) {
+		if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
+		    wideValue = ~(Tcl_WideUInt)0 >> 1;	/* WIDE_MAX */
+		    if (TclGetString(objPtr)[0] == '-') {
+			wideValue++;	/* WIDE_MAX + 1 = WIDE_MIN */
+		    }
+		}
+		if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
+		    sprintf(buf, "%" TCL_LL_MODIFIER "u",
+			    (Tcl_WideUInt)wideValue);
+		    Tcl_SetStringObj(objPtr, buf, -1);
+		} else {
+		    Tcl_SetWideIntObj(objPtr, wideValue);
+		}
+	    } else if (!(flags & SCAN_BIG)) {
+		if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) {
+		    if (TclGetString(objPtr)[0] == '-') {
+			value = LONG_MIN;
+		    } else {
+			value = LONG_MAX;
+		    }
+		}
+		if ((flags & SCAN_UNSIGNED) && (value < 0)) {
+		    sprintf(buf, "%lu", value);	/* INTL: ISO digit */
+		    Tcl_SetStringObj(objPtr, buf, -1);
+		} else {
+		    Tcl_SetLongObj(objPtr, value);
+		}
+	    }
+	    objs[objIndex++] = objPtr;
+	    break;
+
+	case 'f':
+	    /*
+	     * Scan a floating point number
+	     */
+
+	    objPtr = Tcl_NewDoubleObj(0.0);
+	    Tcl_IncrRefCount(objPtr);
+	    if (width == 0) {
+		width = ~0;
+	    }
+	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
+		    &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE)) {
+		Tcl_DecrRefCount(objPtr);
+		if (width < 0) {
+		    if (*end == '\0') {
+			underflow = 1;
+		    }
+		} else {
+		    if (end == string + width) {
+			underflow = 1;
+		    }
+		}
+		goto done;
+	    } else if (flags & SCAN_SUPPRESS) {
+		Tcl_DecrRefCount(objPtr);
+		string = end;
+	    } else {
+		double dvalue;
+		if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
+#ifdef ACCEPT_NAN
+		    if (objPtr->typePtr == &tclDoubleType) {
+			dvalue = objPtr->internalRep.doubleValue;
+		    } else
+#endif
+		    {
+			Tcl_DecrRefCount(objPtr);
+			goto done;
+		    }
+		}
+		Tcl_SetDoubleObj(objPtr, dvalue);
+		CLANG_ASSERT(objs);
+		objs[objIndex++] = objPtr;
+		string = end;
+	    }
+	}
+	nconversions++;
+    }
+
+  done:
+    result = 0;
+    code = TCL_OK;
+
+    if (numVars) {
+	/*
+	 * In this case, variables were specified (classic scan).
+	 */
+
+	for (i = 0; i < totalVars; i++) {
+	    if (objs[i] == NULL) {
+		continue;
+	    }
+	    result++;
+
+	    /*
+	     * In case of multiple errors in setting variables, just report
+	     * the first one.
+	     */
+
+	    if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i],
+		    (code == TCL_OK) ? TCL_LEAVE_ERR_MSG : 0) == NULL) {
+		code = TCL_ERROR;
+	    }
+	    Tcl_DecrRefCount(objs[i]);
+	}
+    } else {
+	/*
+	 * Here no vars were specified, we want a list returned (inline scan)
+	 */
+
+	objPtr = Tcl_NewObj();
+	for (i = 0; i < totalVars; i++) {
+	    if (objs[i] != NULL) {
+		Tcl_ListObjAppendElement(NULL, objPtr, objs[i]);
+		Tcl_DecrRefCount(objs[i]);
+	    } else {
+		/*
+		 * More %-specifiers than matching chars, so we just spit out
+		 * empty strings for these.
+		 */
+
+		Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj());
+	    }
+	}
+    }
+    if (objs != NULL) {
+	ckfree(objs);
+    }
+    if (code == TCL_OK) {
+	if (underflow && (nconversions == 0)) {
+	    if (numVars) {
+		objPtr = Tcl_NewIntObj(-1);
+	    } else {
+		if (objPtr) {
+		    Tcl_SetListObj(objPtr, 0, NULL);
+		} else {
+		    objPtr = Tcl_NewObj();
+		}
+	    }
+	} else if (numVars) {
+	    objPtr = Tcl_NewIntObj(result);
+	}
+	Tcl_SetObjResult(interp, objPtr);
+    }
+    return code;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */