summaryrefslogtreecommitdiffstats
path: root/generic/tclScan.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclScan.c')
-rw-r--r--generic/tclScan.c234
1 files changed, 127 insertions, 107 deletions
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 54f9b78..eede9f3 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -8,7 +8,7 @@
* 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.18 2005/07/21 14:38:51 dkf Exp $
+ * RCS: @(#) $Id: tclScan.c,v 1.19 2005/10/08 14:42:45 dgp Exp $
*/
#include "tclInt.h"
@@ -22,14 +22,17 @@
#define SCAN_UNSIGNED 0x4 /* Read an unsigned value. */
#define SCAN_WIDTH 0x8 /* A width value was supplied. */
+#if 0
#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. */
+#endif
#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
@@ -366,6 +369,12 @@ ValidateFormat(interp, format, numVars, totalSubs)
switch (ch) {
case 'l':
+ if (*format == 'l') {
+ flags |= SCAN_BIG;
+ format += 1;
+ format += Tcl_UtfToUniChar(format, &ch);
+ break;
+ }
case 'L':
flags |= SCAN_LONGER;
case 'h':
@@ -393,11 +402,11 @@ ValidateFormat(interp, format, numVars, totalSubs)
*/
case 'n':
case 's':
- if (flags & SCAN_LONGER) {
- invalidLonger:
+ if (flags & (SCAN_LONGER|SCAN_BIG)) {
+ invalidFieldSize:
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
Tcl_AppendResult(interp,
- "'l' modifier may not be specified in %", buf,
+ "field size modifier may not be specified in %", buf,
" conversion", NULL);
goto error;
}
@@ -410,15 +419,21 @@ ValidateFormat(interp, format, numVars, totalSubs)
case 'g':
case 'i':
case 'o':
- case 'u':
case 'x':
break;
+ case 'u':
+ if (flags & SCAN_BIG) {
+ Tcl_SetResult(interp,
+ "unsigned bignum scans are invalid", TCL_STATIC);
+ goto error;
+ }
+ break;
/*
* Bracket terms need special checking
*/
case '[':
- if (flags & SCAN_LONGER) {
- goto invalidLonger;
+ if (flags & (SCAN_LONGER|SCAN_BIG)) {
+ goto invalidFieldSize;
}
if (*format == '\0') {
goto badSet;
@@ -574,22 +589,24 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
int numVars, nconversions, totalVars = -1;
int objIndex, offset, i, result, code;
long value;
- char *string, *end, *baseString;
+ CONST char *string, *end, *baseString;
char op = 0;
- int base = 0;
int underflow = 0;
size_t width;
- long (*fn) _ANSI_ARGS_((char*,void*,int)) = NULL;
-#ifndef TCL_WIDE_INT_IS_LONG
- Tcl_WideInt (*lfn) _ANSI_ARGS_((char*,void*,int)) = NULL;
Tcl_WideInt wideValue;
-#endif
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 0
+ int base = 0;
+ long (*fn) _ANSI_ARGS_((char*,void*,int)) = NULL;
+#ifndef TCL_WIDE_INT_IS_LONG
+ Tcl_WideInt (*lfn) _ANSI_ARGS_((char*,void*,int)) = NULL;
+#endif
+#endif
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -631,6 +648,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
objIndex = 0;
nconversions = 0;
while (*format != '\0') {
+ int parseFlag = 0;
format += Tcl_UtfToUniChar(format, &ch);
flags = 0;
@@ -678,9 +696,10 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
flags |= SCAN_SUPPRESS;
format += Tcl_UtfToUniChar(format, &ch);
} else if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
- value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */
- if (*end == '$') {
- format = end+1;
+ char *formatEnd;
+ value = strtoul(format-1, &formatEnd, 10);/* INTL: "C" locale. */
+ if (*formatEnd == '$') {
+ format = formatEnd+1;
format += Tcl_UtfToUniChar(format, &ch);
objIndex = (int) value - 1;
}
@@ -703,6 +722,12 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
switch (ch) {
case 'l':
+ if (*format == 'l') {
+ flags |= SCAN_BIG;
+ format += 1;
+ format += Tcl_UtfToUniChar(format, &ch);
+ break;
+ }
case 'L':
flags |= SCAN_LONGER;
/*
@@ -728,44 +753,58 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
case 'd':
op = 'i';
+ parseFlag = TCL_PARSE_DECIMAL_ONLY;
+#if 0
base = 10;
fn = (long (*) _ANSI_ARGS_((char*,void*,int)))strtol;
#ifndef TCL_WIDE_INT_IS_LONG
lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoll;
#endif
+#endif
break;
case 'i':
op = 'i';
+ parseFlag = TCL_PARSE_SCAN_PREFIXES;
+#if 0
base = 0;
fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtol;
#ifndef TCL_WIDE_INT_IS_LONG
lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoll;
#endif
+#endif
break;
case 'o':
op = 'i';
+ parseFlag = TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES;
+#if 0
base = 8;
fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtoul;
#ifndef TCL_WIDE_INT_IS_LONG
lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoull;
#endif
+#endif
break;
case 'x':
op = 'i';
+ parseFlag = TCL_PARSE_HEXADECIMAL_ONLY;
+#if 0
base = 16;
fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtoul;
#ifndef TCL_WIDE_INT_IS_LONG
lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoull;
#endif
+#endif
break;
case 'u':
op = 'i';
- base = 10;
flags |= SCAN_UNSIGNED;
+#if 0
+ base = 10;
fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtoul;
#ifndef TCL_WIDE_INT_IS_LONG
lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoull;
#endif
+#endif
break;
case 'f':
@@ -903,6 +942,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
* Scan an unsigned or signed integer.
*/
+#if 0
if ((width == 0) || (width > sizeof(buf) - 1)) {
width = sizeof(buf) - 1;
}
@@ -1049,111 +1089,91 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
}
break;
-
- case 'f':
- /*
- * Scan a floating point number
- */
-
- if ((width == 0) || (width > sizeof(buf) - 1)) {
- width = sizeof(buf) - 1;
+#else
+ objPtr = Tcl_NewLongObj(0);
+ Tcl_IncrRefCount(objPtr);
+ if (width == 0) {
+ width = -1;
}
- flags &= ~SCAN_LONGER;
- flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_PTOK | SCAN_EXPOK;
- for (end = buf; width > 0; width--) {
- switch (*string) {
- case '0': case '1': case '2': case '3':
- case '4': case '5': case '6': case '7':
- case '8': case '9':
- flags &= ~(SCAN_SIGNOK | SCAN_NODIGITS);
- goto addToFloat;
- case '+': case '-':
- if (flags & SCAN_SIGNOK) {
- flags &= ~SCAN_SIGNOK;
- goto addToFloat;
- }
- break;
- case '.':
- if (flags & SCAN_PTOK) {
- flags &= ~(SCAN_SIGNOK | SCAN_PTOK);
- goto addToFloat;
- }
- break;
- case 'e': case 'E':
- /*
- * An exponent is not allowed until there has been at
- * least one digit.
- */
-
- if ((flags & (SCAN_NODIGITS | SCAN_EXPOK)) == SCAN_EXPOK) {
- flags = (flags & ~(SCAN_EXPOK|SCAN_PTOK))
- | SCAN_SIGNOK | SCAN_NODIGITS;
- goto addToFloat;
+ if (TclParseNumber(NULL, objPtr, NULL, string, width, &end,
+ TCL_PARSE_INTEGER_ONLY | parseFlag) != TCL_OK) {
+ Tcl_DecrRefCount(objPtr);
+ /* TODO: set underflow? test scan-4.44 */
+ 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 (Tcl_GetString(objPtr)[0] == '-') {
+ wideValue++; /* WIDE_MAX + 1 = WIDE_MIN */
}
- break;
}
-
- /*
- * We got an illegal character so we are done accumulating.
- */
-
- break;
-
- addToFloat:
- /*
- * Add the character to the temporary buffer.
- */
-
- *end++ = *string++;
- if (*string == '\0') {
- break;
+ 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);
}
- }
-
- /*
- * Check to see if we need to back up because we saw a trailing
- * 'e' or sign.
- */
-
- if (flags & SCAN_NODIGITS) {
- if (flags & SCAN_EXPOK) {
- /*
- * There were no digits at all so scanning has failed and
- * we are done.
- */
-
- if (*string == '\0') {
- underflow = 1;
+ } else if (!(flags & SCAN_BIG)) {
+ if (Tcl_GetLongFromObj(NULL, objPtr, &value) != TCL_OK) {
+ if (Tcl_GetString(objPtr)[0] == '-') {
+ value = LONG_MIN;
+ } else {
+ value = LONG_MAX;
}
- goto done;
}
-
- /*
- * We got a bad exponent ('e' and maybe a sign).
- */
-
- end--;
- string--;
- if (*end != 'e' && *end != 'E') {
- end--;
- string--;
+ 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;
+#endif
+ case 'f':
/*
- * Scan the value from the temporary buffer.
+ * Scan a floating point number
*/
- if (!(flags & SCAN_SUPPRESS)) {
+ objPtr = Tcl_NewDoubleObj(0.0);
+ Tcl_IncrRefCount(objPtr);
+ if (width == 0) {
+ width = -1;
+ }
+ if (TclParseNumber(NULL, objPtr, NULL, string, width, &end,
+ TCL_PARSE_DECIMAL_ONLY) != TCL_OK) {
+ /* TODO: set underflow? test scan-4.55 */
+ Tcl_DecrRefCount(objPtr);
+ goto done;
+ } else if (flags & SCAN_SUPPRESS) {
+ Tcl_DecrRefCount(objPtr);
+ string = end;
+ } else {
double dvalue;
-
- *end = '\0';
- dvalue = TclStrToD(buf, NULL);
- objPtr = Tcl_NewDoubleObj(dvalue);
- Tcl_IncrRefCount(objPtr);
+ 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);
objs[objIndex++] = objPtr;
+ string = end;
}
- break;
}
nconversions++;
}