summaryrefslogtreecommitdiffstats
path: root/generic/tclScan.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclScan.c')
-rw-r--r--generic/tclScan.c123
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) {