summaryrefslogtreecommitdiffstats
path: root/generic/tclScan.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclScan.c')
-rw-r--r--generic/tclScan.c351
1 files changed, 141 insertions, 210 deletions
diff --git a/generic/tclScan.c b/generic/tclScan.c
index d2dcc70..229f3fa 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -3,14 +3,13 @@
*
* This file contains the implementation of the "scan" command.
*
- * Copyright © 1998 Scriptics Corporation.
+ * 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"
-#include "tclTomMath.h"
/*
* Flag values used by Tcl_ScanObjCmd.
@@ -29,27 +28,25 @@
* character set.
*/
-typedef struct {
- Tcl_UniChar start;
- Tcl_UniChar end;
-} Range;
-
-typedef struct {
+typedef struct CharSet {
int exclude; /* 1 if this is an exclusion set. */
int nchars;
Tcl_UniChar *chars;
int nranges;
- Range *ranges;
+ 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 char * BuildCharSet(CharSet *cset, char *format);
static int CharInSet(CharSet *cset, int ch);
static void ReleaseCharSet(CharSet *cset);
-static int ValidateFormat(Tcl_Interp *interp, const char *format,
+static int ValidateFormat(Tcl_Interp *interp, char *format,
int numVars, int *totalVars);
/*
@@ -70,22 +67,22 @@ static int ValidateFormat(Tcl_Interp *interp, const char *format,
*----------------------------------------------------------------------
*/
-static const char *
+static char *
BuildCharSet(
CharSet *cset,
- const char *format) /* Points to first char of set. */
+ char *format) /* Points to first char of set. */
{
- Tcl_UniChar ch = 0, start;
+ Tcl_UniChar ch, start;
int offset, nranges;
- const char *end;
+ char *end;
memset(cset, 0, sizeof(CharSet));
- offset = TclUtfToUniChar(format, &ch);
+ offset = Tcl_UtfToUniChar(format, &ch);
if (ch == '^') {
cset->exclude = 1;
format += offset;
- offset = TclUtfToUniChar(format, &ch);
+ offset = Tcl_UtfToUniChar(format, &ch);
}
end = format + offset;
@@ -94,19 +91,20 @@ BuildCharSet(
*/
if (ch == ']') {
- end += TclUtfToUniChar(end, &ch);
+ end += Tcl_UtfToUniChar(end, &ch);
}
nranges = 0;
while (ch != ']') {
if (ch == '-') {
nranges++;
}
- end += TclUtfToUniChar(end, &ch);
+ end += Tcl_UtfToUniChar(end, &ch);
}
- cset->chars = (Tcl_UniChar *)ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
+ cset->chars = (Tcl_UniChar *)
+ ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
if (nranges > 0) {
- cset->ranges = (Range *)ckalloc(sizeof(Range) * nranges);
+ cset->ranges = (struct Range *) ckalloc(sizeof(struct Range)*nranges);
} else {
cset->ranges = NULL;
}
@@ -116,11 +114,11 @@ BuildCharSet(
*/
cset->nchars = cset->nranges = 0;
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
start = ch;
if (ch == ']' || ch == '-') {
cset->chars[cset->nchars++] = ch;
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
}
while (ch != ']') {
if (*format == '-') {
@@ -137,11 +135,11 @@ BuildCharSet(
* as well as the dash.
*/
- if (*format == ']' || !cset->ranges) {
+ if (*format == ']') {
cset->chars[cset->nchars++] = start;
cset->chars[cset->nchars++] = ch;
} else {
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
/*
* Check to see if the range is in reverse order.
@@ -159,7 +157,7 @@ BuildCharSet(
} else {
cset->chars[cset->nchars++] = ch;
}
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
}
return format;
}
@@ -226,9 +224,9 @@ static void
ReleaseCharSet(
CharSet *cset)
{
- ckfree(cset->chars);
+ ckfree((char *)cset->chars);
if (cset->ranges) {
- ckfree(cset->ranges);
+ ckfree((char *)cset->ranges);
}
}
@@ -252,7 +250,7 @@ ReleaseCharSet(
static int
ValidateFormat(
Tcl_Interp *interp, /* Current interpreter. */
- const char *format, /* The format string. */
+ 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
@@ -260,14 +258,10 @@ ValidateFormat(
{
int gotXpg, gotSequential, value, i, flags;
char *end;
- Tcl_UniChar ch = 0;
+ Tcl_UniChar ch;
int objIndex, xpgSize, nspace = numVars;
- int *nassign = (int *)TclStackAlloc(interp, nspace * sizeof(int));
- 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! */
- char buf[5] = "";
+ int *nassign = (int *) TclStackAlloc(interp, nspace * sizeof(int));
+ char buf[TCL_UTF_MAX+1];
/*
* Initialize an array that records the number of times a variable is
@@ -282,20 +276,20 @@ ValidateFormat(
xpgSize = objIndex = gotXpg = gotSequential = 0;
while (*format != '\0') {
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
flags = 0;
if (ch != '%') {
continue;
}
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
if (ch == '%') {
continue;
}
if (ch == '*') {
flags |= SCAN_SUPPRESS;
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
goto xpgCheckDone;
}
@@ -306,30 +300,27 @@ ValidateFormat(
* format string.
*/
- unsigned long ul = strtoul(format-1, &end, 10); /* INTL: "C" locale. */
+ value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */
if (*end != '$') {
goto notXpg;
}
format = end+1;
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
gotXpg = 1;
if (gotSequential) {
goto mixedXPG;
}
- if (ul == 0 || ul >= INT_MAX) {
- goto badIndex;
- }
- objIndex = (int) ul - 1;
- if (numVars && (objIndex >= numVars)) {
+ 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. 'ul' is guaranteed
- * to be > 0 and < INT_MAX as per checks above.
+ * rules for growing the assign array. 'value' is guaranteed
+ * to be > 0.
*/
- xpgSize = (xpgSize > (int)ul) ? xpgSize : (int)ul;
+ xpgSize = (xpgSize > value) ? xpgSize : value;
}
goto xpgCheckDone;
}
@@ -338,10 +329,9 @@ ValidateFormat(
gotSequential = 1;
if (gotXpg) {
mixedXPG:
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ Tcl_SetResult(interp,
"cannot mix \"%\" and \"%n$\" conversion specifiers",
- -1));
- Tcl_SetErrorCode(interp, "TCL", "FORMAT", "MIXEDSPECTYPES", (void *)NULL);
+ TCL_STATIC);
goto error;
}
@@ -351,9 +341,9 @@ ValidateFormat(
*/
if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
- value = strtoul(format-1, (char **) &format, 10); /* INTL: "C" locale. */
+ value = strtoul(format-1, &format, 10); /* INTL: "C" locale. */
flags |= SCAN_WIDTH;
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
}
/*
@@ -365,15 +355,13 @@ ValidateFormat(
if (*format == 'l') {
flags |= SCAN_BIG;
format += 1;
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
break;
}
- /* FALLTHRU */
case 'L':
flags |= SCAN_LONGER;
- /* FALLTHRU */
case 'h':
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
}
if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) {
@@ -387,24 +375,22 @@ ValidateFormat(
switch (ch) {
case 'c':
if (flags & SCAN_WIDTH) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ Tcl_SetResult(interp,
"field width may not be specified in %c conversion",
- -1));
- Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", (void *)NULL);
+ TCL_STATIC);
goto error;
}
- /* FALLTHRU */
+ /*
+ * 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", (void *)NULL);
+ Tcl_AppendResult(interp,
+ "field size modifier may not be specified in %", buf,
+ " conversion", NULL);
goto error;
}
/*
@@ -420,8 +406,13 @@ ValidateFormat(
case 'o':
case 'x':
case 'X':
- case 'b':
+ 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
@@ -433,40 +424,39 @@ ValidateFormat(
if (*format == '\0') {
goto badSet;
}
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
if (ch == '^') {
if (*format == '\0') {
goto badSet;
}
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
}
if (ch == ']') {
if (*format == '\0') {
goto badSet;
}
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
}
while (ch != ']') {
if (*format == '\0') {
goto badSet;
}
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
}
break;
badSet:
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "unmatched [ in format string", -1));
- Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", (void *)NULL);
+ Tcl_SetResult(interp, "unmatched [ in format string",
+ TCL_STATIC);
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", (void *)NULL);
- goto error;
+ {
+ char buf[TCL_UTF_MAX+1];
+
+ buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
+ Tcl_AppendResult(interp, "bad scan conversion character \"",
+ buf, "\"", NULL);
+ goto error;
+ }
}
if (!(flags & SCAN_SUPPRESS)) {
if (objIndex >= nspace) {
@@ -482,7 +472,7 @@ ValidateFormat(
} else {
nspace += 16; /* formerly STATIC_LIST_SIZE */
}
- nassign = (int *)TclStackRealloc(interp, nassign,
+ nassign = (int *) TclStackRealloc(interp, nassign,
nspace * sizeof(int));
for (i = value; i < nspace; i++) {
nassign[i] = 0;
@@ -509,10 +499,9 @@ ValidateFormat(
}
for (i = 0; i < numVars; i++) {
if (nassign[i] > 1) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ Tcl_SetResult(interp,
"variable is assigned by multiple \"%n$\" conversion specifiers",
- -1));
- Tcl_SetErrorCode(interp, "TCL", "FORMAT", "POLYASSIGNED", (void *)NULL);
+ TCL_STATIC);
goto error;
} else if (!xpgSize && (nassign[i] == 0)) {
/*
@@ -520,10 +509,9 @@ ValidateFormat(
* and/or numVars != 0), then too many vars were given
*/
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ Tcl_SetResult(interp,
"variable is not assigned by any conversion specifiers",
- -1));
- Tcl_SetErrorCode(interp, "TCL", "FORMAT", "UNASSIGNED", (void *)NULL);
+ TCL_STATIC);
goto error;
}
}
@@ -533,14 +521,12 @@ ValidateFormat(
badIndex:
if (gotXpg) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "\"%n$\" argument index out of range", -1));
- Tcl_SetErrorCode(interp, "TCL", "FORMAT", "INDEXRANGE", (void *)NULL);
+ Tcl_SetResult(interp, "\"%n$\" argument index out of range",
+ TCL_STATIC);
} else {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ Tcl_SetResult(interp,
"different numbers of variable names and field specifiers",
- -1));
- Tcl_SetErrorCode(interp, "TCL", "FORMAT", "FIELDVARMISMATCH", (void *)NULL);
+ TCL_STATIC);
}
error:
@@ -565,32 +551,36 @@ ValidateFormat(
*----------------------------------------------------------------------
*/
+ /* ARGSUSED */
int
Tcl_ScanObjCmd(
- TCL_UNUSED(ClientData),
+ ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument objects. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
- const char *format;
+ char *format;
int numVars, nconversions, totalVars = -1;
int objIndex, offset, i, result, code;
long value;
- const char *string, *end, *baseString;
+ CONST char *string, *end, *baseString;
char op = 0;
int width, underflow = 0;
Tcl_WideInt wideValue;
- Tcl_UniChar ch = 0, sch = 0;
+ 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 ...?");
+ "string format ?varName varName ...?");
return TCL_ERROR;
}
- format = Tcl_GetString(objv[2]);
+ format = Tcl_GetStringFromObj(objv[2], NULL);
numVars = objc-3;
/*
@@ -606,13 +596,13 @@ Tcl_ScanObjCmd(
*/
if (totalVars > 0) {
- objs = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * totalVars);
+ objs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj*) * totalVars);
for (i = 0; i < totalVars; i++) {
objs[i] = NULL;
}
}
- string = Tcl_GetString(objv[1]);
+ string = Tcl_GetStringFromObj(objv[1], NULL);
baseString = string;
/*
@@ -625,7 +615,7 @@ Tcl_ScanObjCmd(
nconversions = 0;
while (*format != '\0') {
int parseFlag = TCL_PARSE_NO_WHITESPACE;
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
flags = 0;
@@ -634,13 +624,13 @@ Tcl_ScanObjCmd(
*/
if (Tcl_UniCharIsSpace(ch)) {
- offset = TclUtfToUniChar(string, &sch);
+ offset = Tcl_UtfToUniChar(string, &sch);
while (Tcl_UniCharIsSpace(sch)) {
if (*string == '\0') {
goto done;
}
string += offset;
- offset = TclUtfToUniChar(string, &sch);
+ offset = Tcl_UtfToUniChar(string, &sch);
}
continue;
}
@@ -651,14 +641,14 @@ Tcl_ScanObjCmd(
underflow = 1;
goto done;
}
- string += TclUtfToUniChar(string, &sch);
+ string += Tcl_UtfToUniChar(string, &sch);
if (ch != sch) {
goto done;
}
continue;
}
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
if (ch == '%') {
goto literal;
}
@@ -670,13 +660,13 @@ Tcl_ScanObjCmd(
if (ch == '*') {
flags |= SCAN_SUPPRESS;
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(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);
+ format += Tcl_UtfToUniChar(format, &ch);
objIndex = (int) value - 1;
}
}
@@ -686,8 +676,8 @@ Tcl_ScanObjCmd(
*/
if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
- width = (int) strtoul(format-1, (char **) &format, 10);/* INTL: "C" locale. */
- format += TclUtfToUniChar(format, &ch);
+ width = (int) strtoul(format-1, &format, 10);/* INTL: "C" locale. */
+ format += Tcl_UtfToUniChar(format, &ch);
} else {
width = 0;
}
@@ -701,15 +691,16 @@ Tcl_ScanObjCmd(
if (*format == 'l') {
flags |= SCAN_BIG;
format += 1;
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
break;
}
- /* FALLTHRU */
case 'L':
flags |= SCAN_LONGER;
- /* FALLTHRU */
+ /*
+ * Fall through so we skip to the next character.
+ */
case 'h':
- format += TclUtfToUniChar(format, &ch);
+ format += Tcl_UtfToUniChar(format, &ch);
}
/*
@@ -719,9 +710,8 @@ Tcl_ScanObjCmd(
switch (ch) {
case 'n':
if (!(flags & SCAN_SUPPRESS)) {
- TclNewIntObj(objPtr, string - baseString);
+ objPtr = Tcl_NewIntObj(string - baseString);
Tcl_IncrRefCount(objPtr);
- CLANG_ASSERT(objs);
objs[objIndex++] = objPtr;
}
nconversions++;
@@ -744,10 +734,6 @@ Tcl_ScanObjCmd(
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;
@@ -793,7 +779,7 @@ Tcl_ScanObjCmd(
if (!(flags & SCAN_NOSKIP)) {
while (*string != '\0') {
- offset = TclUtfToUniChar(string, &sch);
+ offset = Tcl_UtfToUniChar(string, &sch);
if (!Tcl_UniCharIsSpace(sch)) {
break;
}
@@ -820,7 +806,7 @@ Tcl_ScanObjCmd(
}
end = string;
while (*end != '\0') {
- offset = TclUtfToUniChar(end, &sch);
+ offset = Tcl_UtfToUniChar(end, &sch);
if (Tcl_UniCharIsSpace(sch)) {
break;
}
@@ -832,7 +818,6 @@ Tcl_ScanObjCmd(
if (!(flags & SCAN_SUPPRESS)) {
objPtr = Tcl_NewStringObj(string, end-string);
Tcl_IncrRefCount(objPtr);
- CLANG_ASSERT(objs);
objs[objIndex++] = objPtr;
}
string = end;
@@ -848,7 +833,7 @@ Tcl_ScanObjCmd(
format = BuildCharSet(&cset, format);
while (*end != '\0') {
- offset = TclUtfToUniChar(end, &sch);
+ offset = Tcl_UtfToUniChar(end, &sch);
if (!CharInSet(&cset, (int)sch)) {
break;
}
@@ -879,12 +864,10 @@ Tcl_ScanObjCmd(
* Scan a single Unicode character.
*/
- offset = TclUtfToUniChar(string, &i);
- string += offset;
+ string += Tcl_UtfToUniChar(string, &sch);
if (!(flags & SCAN_SUPPRESS)) {
- TclNewIntObj(objPtr, i);
+ objPtr = Tcl_NewIntObj((int)sch);
Tcl_IncrRefCount(objPtr);
- CLANG_ASSERT(objs);
objs[objIndex++] = objPtr;
}
break;
@@ -893,13 +876,13 @@ Tcl_ScanObjCmd(
/*
* Scan an unsigned or signed integer.
*/
- TclNewIntObj(objPtr, 0);
+ 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 | TCL_PARSE_NO_UNDERSCORE | parseFlag)) {
+ &end, TCL_PARSE_INTEGER_ONLY | parseFlag)) {
Tcl_DecrRefCount(objPtr);
if (width < 0) {
if (*end == '\0') {
@@ -919,50 +902,19 @@ Tcl_ScanObjCmd(
}
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_MIN;
- } else {
- wideValue = WIDE_MAX;
+ wideValue++; /* WIDE_MAX + 1 = WIDE_MIN */
}
}
if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
- mp_int big;
- if (mp_init_u64(&big, (Tcl_WideUInt)wideValue) != MP_OKAY) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "insufficient memory to create bignum", -1));
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL);
- return TCL_ERROR;
- } else {
- Tcl_SetBignumObj(objPtr, &big);
- }
+ sprintf(buf, "%" TCL_LL_MODIFIER "u",
+ (Tcl_WideUInt)wideValue);
+ Tcl_SetStringObj(objPtr, buf, -1);
} else {
- TclSetIntObj(objPtr, wideValue);
- }
- } else if (flags & SCAN_BIG) {
- if (flags & SCAN_UNSIGNED) {
- mp_int big;
- int res = Tcl_GetBignumFromObj(interp, objPtr, &big);
-
- if (res == TCL_OK) {
- if (mp_isneg(&big)) {
- res = TCL_ERROR;
- }
- mp_clear(&big);
- }
-
- if (res == 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", (void *)NULL);
- return TCL_ERROR;
- }
+ Tcl_SetWideIntObj(objPtr, wideValue);
}
- } else {
+ } else if (!(flags & SCAN_BIG)) {
if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) {
if (TclGetString(objPtr)[0] == '-') {
value = LONG_MIN;
@@ -971,21 +923,10 @@ Tcl_ScanObjCmd(
}
}
if ((flags & SCAN_UNSIGNED) && (value < 0)) {
-#ifdef TCL_WIDE_INT_IS_LONG
- mp_int big;
- if (mp_init_u64(&big, (unsigned long)value) != MP_OKAY) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "insufficient memory to create bignum", -1));
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL);
- return TCL_ERROR;
- } else {
- Tcl_SetBignumObj(objPtr, &big);
- }
-#else
- Tcl_SetWideIntObj(objPtr, (unsigned long)value);
-#endif
+ sprintf(buf, "%lu", value); /* INTL: ISO digit */
+ Tcl_SetStringObj(objPtr, buf, -1);
} else {
- TclSetIntObj(objPtr, value);
+ Tcl_SetLongObj(objPtr, value);
}
}
objs[objIndex++] = objPtr;
@@ -996,13 +937,13 @@ Tcl_ScanObjCmd(
* Scan a floating point number
*/
- TclNewDoubleObj(objPtr, 0.0);
+ 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_PARSE_NO_UNDERSCORE)) {
+ &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE)) {
Tcl_DecrRefCount(objPtr);
if (width < 0) {
if (*end == '\0') {
@@ -1021,10 +962,8 @@ Tcl_ScanObjCmd(
double dvalue;
if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
#ifdef ACCEPT_NAN
- const Tcl_ObjInternalRep *irPtr
- = TclFetchInternalRep(objPtr, &tclDoubleType);
- if (irPtr) {
- dvalue = irPtr->doubleValue;
+ if (objPtr->typePtr == &tclDoubleType) {
+ dvalue = objPtr->internalRep.doubleValue;
} else
#endif
{
@@ -1033,7 +972,6 @@ Tcl_ScanObjCmd(
}
}
Tcl_SetDoubleObj(objPtr, dvalue);
- CLANG_ASSERT(objs);
objs[objIndex++] = objPtr;
string = end;
}
@@ -1055,14 +993,9 @@ Tcl_ScanObjCmd(
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) {
+ if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], 0) == NULL) {
+ Tcl_AppendResult(interp, "couldn't set variable \"",
+ TclGetString(objv[i+3]), "\"", NULL);
code = TCL_ERROR;
}
Tcl_DecrRefCount(objs[i]);
@@ -1072,39 +1005,37 @@ Tcl_ScanObjCmd(
* Here no vars were specified, we want a list returned (inline scan)
*/
- TclNewObj(objPtr);
+ objPtr = Tcl_NewObj();
for (i = 0; i < totalVars; i++) {
if (objs[i] != NULL) {
Tcl_ListObjAppendElement(NULL, objPtr, objs[i]);
Tcl_DecrRefCount(objs[i]);
} else {
- Tcl_Obj *obj;
/*
* More %-specifiers than matching chars, so we just spit out
* empty strings for these.
*/
- TclNewObj(obj);
- Tcl_ListObjAppendElement(NULL, objPtr, obj);
+ Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj());
}
}
}
if (objs != NULL) {
- ckfree(objs);
+ ckfree((char*) objs);
}
if (code == TCL_OK) {
if (underflow && (nconversions == 0)) {
if (numVars) {
- TclNewIntObj(objPtr, -1);
+ objPtr = Tcl_NewIntObj(-1);
} else {
if (objPtr) {
Tcl_SetListObj(objPtr, 0, NULL);
} else {
- TclNewObj(objPtr);
+ objPtr = Tcl_NewObj();
}
}
} else if (numVars) {
- TclNewIntObj(objPtr, result);
+ objPtr = Tcl_NewIntObj(result);
}
Tcl_SetObjResult(interp, objPtr);
}
generated by cgit v0.12 at 2025-12-20 09:33:32 (GMT)