TIP#72 implementation. See ChangeLog for details.

This version builds clean on Solaris/SPARC, with GCC and CC, both with and
without threads and both in 32-bit and 64-bit mode.

1 files changed, 99 insertions, 24 deletions

diff --git a/generic/tclScan.c b/generic/tclScan.c
index d631116..9eb60e7 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -8,10 +8,14 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclScan.c,v 1.10 2002/02/08 09:33:24 hobbs Exp $
+ * RCS: @(#) $Id: tclScan.c,v 1.11 2002/02/15 14:28:49 dkf Exp $
  */
 
 #include "tclInt.h"
+/*
+ * For strtoll() and strtoull() declarations on some platforms...
+ */
+#include "tclPort.h"
 
 /*
  * Flag values used by Tcl_ScanObjCmd.
@@ -29,6 +33,7 @@
 #define SCAN_PTOK	0x100		  /* Decimal point is allowed. */
 #define SCAN_EXPOK	0x200		  /* An exponent is allowed. */
 
+#define SCAN_LONGER	0x400		  /* Asked for a wide value. */
 
 /*
  * The following structure contains the information associated with
@@ -270,6 +275,7 @@ ValidateFormat(interp, format, numVars, totalSubs)
     int staticAssign[STATIC_LIST_SIZE];
     int *nassign = staticAssign;
     int objIndex, xpgSize, nspace = STATIC_LIST_SIZE;
+    char buf[TCL_UTF_MAX+1];
 
     /*
      * Initialize an array that records the number of times a variable
@@ -359,10 +365,16 @@ ValidateFormat(interp, format, numVars, totalSubs)
 	}
 
 	/*
-	 * Ignore size specifier.
+	 * Handle any size specifier.
 	 */
 
- 	if ((ch == 'l') || (ch == 'L') || (ch == 'h')) {
+	switch (ch) {
+	case 'l':
+	case 'L':
+#ifndef TCL_WIDE_INT_IS_LONG
+	    flags |= SCAN_LONGER;
+#endif
+	case 'h':
 	    format += Tcl_UtfToUniChar(format, &ch);
 	}
 
@@ -375,24 +387,45 @@ ValidateFormat(interp, format, numVars, totalSubs)
 	 */
 
 	switch (ch) {
+	    case 'c':
+                if (flags & SCAN_WIDTH) {
+		    Tcl_SetResult(interp,
+			    "field width may not be specified in %c conversion",
+			    TCL_STATIC);
+		    goto error;
+                }
+		/*
+		 * Fall through!
+		 */
 	    case 'n':
+	    case 's':
+		if (flags & SCAN_LONGER) {
+		invalidLonger:
+		    buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
+		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+			   "'l' modifier may not be specified in %", buf,
+			   " conversion", NULL);
+		    goto error;
+		}
+		/*
+		 * Fall through!
+		 */
 	    case 'd':
+	    case 'e':
+	    case 'f':
+	    case 'g':
 	    case 'i':
 	    case 'o':
-	    case 'x':
 	    case 'u':
-	    case 'f':
-	    case 'e':
-	    case 'g':
-	    case 's':
-		break;
-	    case 'c':
-                if (flags & SCAN_WIDTH) {
-		    Tcl_SetResult(interp, "field width may not be specified in %c conversion", TCL_STATIC);
-		    goto error;
-                }
-		break;
+	    case 'x':
+ 		break;
+		/*
+		 * Bracket terms need special checking
+		 */
 	    case '[':
+		if (flags & SCAN_LONGER) {
+		    goto invalidLonger;
+		}
 		if (*format == '\0') {
 		    goto badSet;
 		}
@@ -547,6 +580,10 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
     int underflow = 0;
     size_t width;
     long (*fn)() = NULL;
+#ifndef TCL_WIDE_INT_IS_LONG
+    Tcl_WideInt (*lfn)() = NULL;
+    Tcl_WideInt wideValue;
+#endif
     Tcl_UniChar ch, sch;
     Tcl_Obj **objs = NULL, *objPtr = NULL;
     int flags;
@@ -661,10 +698,16 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
 	}
 
 	/*
-	 * Ignore size specifier.
+	 * Handle any size specifier.
 	 */
 
- 	if ((ch == 'l') || (ch == 'L') || (ch == 'h')) {
+	switch (ch) {
+	case 'l':
+	case 'L':
+#ifndef TCL_WIDE_INT_IS_LONG
+	    flags |= SCAN_LONGER;
+#endif
+	case 'h':
 	    format += Tcl_UtfToUniChar(format, &ch);
 	}
 
@@ -686,27 +729,42 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
 		op = 'i';
 		base = 10;
 		fn = (long (*)())strtol;
+#ifndef TCL_WIDE_INT_IS_LONG
+		lfn = (Tcl_WideInt (*)())strtoll;
+#endif
 		break;
 	    case 'i':
 		op = 'i';
 		base = 0;
 		fn = (long (*)())strtol;
+#ifndef TCL_WIDE_INT_IS_LONG
+		lfn = (Tcl_WideInt (*)())strtoll;
+#endif
 		break;
 	    case 'o':
 		op = 'i';
 		base = 8;
 		fn = (long (*)())strtoul;
+#ifndef TCL_WIDE_INT_IS_LONG
+		lfn = (Tcl_WideInt (*)())strtoull;
+#endif
 		break;
 	    case 'x':
 		op = 'i';
 		base = 16;
 		fn = (long (*)())strtoul;
+#ifndef TCL_WIDE_INT_IS_LONG
+		lfn = (Tcl_WideInt (*)())strtoull;
+#endif
 		break;
 	    case 'u':
 		op = 'i';
 		base = 10;
 		flags |= SCAN_UNSIGNED;
 		fn = (long (*)())strtoul;
+#ifndef TCL_WIDE_INT_IS_LONG
+		lfn = (Tcl_WideInt (*)())strtoull;
+#endif
 		break;
 
 	    case 'f':
@@ -962,17 +1020,33 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
 
 		if (!(flags & SCAN_SUPPRESS)) {
 		    *end = '\0';
-		    value = (long) (*fn)(buf, NULL, base);
-		    if ((flags & SCAN_UNSIGNED) && (value < 0)) {
-			sprintf(buf, "%lu", value); /* INTL: ISO digit */
-			objPtr = Tcl_NewStringObj(buf, -1);
+#ifndef TCL_WIDE_INT_IS_LONG
+		    if (flags & SCAN_LONGER) {
+			wideValue = (Tcl_WideInt) (*lfn)(buf, NULL, base);
+			if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
+			    /* INTL: ISO digit */
+			    sprintf(buf, "%" TCL_LL_MODIFIER "u",
+				    (Tcl_WideUInt)wideValue);
+			    objPtr = Tcl_NewStringObj(buf, -1);
+			} else {
+			    objPtr = Tcl_NewWideIntObj(wideValue);
+			}
 		    } else {
-			if ((unsigned long) value > UINT_MAX) {
-			    objPtr = Tcl_NewLongObj(value);
+#endif /* !TCL_WIDE_INT_IS_LONG */
+			value = (long) (*fn)(buf, NULL, base);
+			if ((flags & SCAN_UNSIGNED) && (value < 0)) {
+			    sprintf(buf, "%lu", value); /* INTL: ISO digit */
+			    objPtr = Tcl_NewStringObj(buf, -1);
 			} else {
-			    objPtr = Tcl_NewIntObj(value);
+			    if ((unsigned long) value > UINT_MAX) {
+				objPtr = Tcl_NewLongObj(value);
+			    } else {
+				objPtr = Tcl_NewIntObj(value);
+			    }
 			}
+#ifndef TCL_WIDE_INT_IS_LONG
 		    }
+#endif
 		    Tcl_IncrRefCount(objPtr);
 		    objs[objIndex++] = objPtr;
 		}
@@ -987,6 +1061,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
 		if ((width == 0) || (width > sizeof(buf) - 1)) {
 		    width = sizeof(buf) - 1;
 		}
+		flags &= ~SCAN_LONGER;
 		flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_PTOK | SCAN_EXPOK;
 		for (end = buf; width > 0; width--) {
 		    switch (*string) {