summaryrefslogtreecommitdiffstats
path: root/generic/tclScan.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclScan.c')
-rw-r--r--generic/tclScan.c176
1 files changed, 96 insertions, 80 deletions
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 91909c8..4dfc2d6 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -7,8 +7,6 @@
*
* 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.23 2005/12/19 19:03:17 dgp Exp $
*/
#include "tclInt.h"
@@ -45,10 +43,10 @@ typedef struct CharSet {
* Declarations for functions used only in this file.
*/
-static char * BuildCharSet(CharSet *cset, char *format);
+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, char *format,
+static int ValidateFormat(Tcl_Interp *interp, const char *format,
int numVars, int *totalVars);
/*
@@ -69,14 +67,14 @@ static int ValidateFormat(Tcl_Interp *interp, char *format,
*----------------------------------------------------------------------
*/
-static char *
+static const char *
BuildCharSet(
CharSet *cset,
- char *format) /* Points to first char of set. */
+ const char *format) /* Points to first char of set. */
{
Tcl_UniChar ch, start;
int offset, nranges;
- char *end;
+ const char *end;
memset(cset, 0, sizeof(CharSet));
@@ -103,10 +101,9 @@ BuildCharSet(
end += Tcl_UtfToUniChar(end, &ch);
}
- cset->chars = (Tcl_UniChar *)
- ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
+ cset->chars = ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
if (nranges > 0) {
- cset->ranges = (struct Range *) ckalloc(sizeof(struct Range)*nranges);
+ cset->ranges = ckalloc(sizeof(struct Range) * nranges);
} else {
cset->ranges = NULL;
}
@@ -226,9 +223,9 @@ static void
ReleaseCharSet(
CharSet *cset)
{
- ckfree((char *)cset->chars);
+ ckfree(cset->chars);
if (cset->ranges) {
- ckfree((char *)cset->ranges);
+ ckfree(cset->ranges);
}
}
@@ -252,20 +249,22 @@ ReleaseCharSet(
static int
ValidateFormat(
Tcl_Interp *interp, /* Current interpreter. */
- char *format, /* The format string. */
+ 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. */
{
-#define STATIC_LIST_SIZE 16
int gotXpg, gotSequential, value, i, flags;
char *end;
Tcl_UniChar ch;
- int staticAssign[STATIC_LIST_SIZE];
- int *nassign = staticAssign;
- int objIndex, xpgSize, nspace = STATIC_LIST_SIZE;
+ 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
@@ -273,10 +272,6 @@ ValidateFormat(
* is multiply assigned or left unassigned.
*/
- if (numVars > nspace) {
- nassign = (int*)ckalloc(sizeof(int) * numVars);
- nspace = numVars;
- }
for (i = 0; i < nspace; i++) {
nassign[i] = 0;
}
@@ -337,9 +332,10 @@ ValidateFormat(
gotSequential = 1;
if (gotXpg) {
mixedXPG:
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot mix \"%\" and \"%n$\" conversion specifiers",
- TCL_STATIC);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "MIXEDSPECTYPES", NULL);
goto error;
}
@@ -349,7 +345,7 @@ ValidateFormat(
*/
if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
- value = strtoul(format-1, &format, 10); /* INTL: "C" locale. */
+ value = strtoul(format-1, (char **) &format, 10); /* INTL: "C" locale. */
flags |= SCAN_WIDTH;
format += Tcl_UtfToUniChar(format, &ch);
}
@@ -383,9 +379,10 @@ ValidateFormat(
switch (ch) {
case 'c':
if (flags & SCAN_WIDTH) {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"field width may not be specified in %c conversion",
- TCL_STATIC);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", NULL);
goto error;
}
/*
@@ -396,9 +393,12 @@ ValidateFormat(
if (flags & (SCAN_LONGER|SCAN_BIG)) {
invalidFieldSize:
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
- Tcl_AppendResult(interp,
- "field size modifier may not be specified in %", buf,
- " conversion", NULL);
+ 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;
}
/*
@@ -406,16 +406,21 @@ ValidateFormat(
*/
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_SetResult(interp,
- "unsigned bignum scans are invalid", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unsigned bignum scans are invalid", -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
goto error;
}
break;
@@ -450,18 +455,19 @@ ValidateFormat(
}
break;
badSet:
- Tcl_SetResult(interp, "unmatched [ in format string",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unmatched [ in format string", -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", NULL);
goto error;
default:
- {
- char buf[TCL_UTF_MAX+1];
-
- buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
- Tcl_AppendResult(interp, "bad scan conversion character \"",
- buf, "\"", NULL);
- goto error;
- }
+ 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) {
@@ -475,16 +481,10 @@ ValidateFormat(
if (xpgSize) {
nspace = xpgSize;
} else {
- nspace += STATIC_LIST_SIZE;
- }
- if (nassign == staticAssign) {
- nassign = (void *) ckalloc(nspace * sizeof(int));
- memcpy((void *) nassign, (void *) staticAssign,
- sizeof(staticAssign));
- } else {
- nassign = (void *) ckrealloc((void *)nassign,
- nspace * sizeof(int));
+ nspace += 16; /* formerly STATIC_LIST_SIZE */
}
+ nassign = TclStackRealloc(interp, nassign,
+ nspace * sizeof(int));
for (i = value; i < nspace; i++) {
nassign[i] = 0;
}
@@ -510,9 +510,10 @@ ValidateFormat(
}
for (i = 0; i < numVars; i++) {
if (nassign[i] > 1) {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"variable is assigned by multiple \"%n$\" conversion specifiers",
- TCL_STATIC);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "POLYASSIGNED", NULL);
goto error;
} else if (!xpgSize && (nassign[i] == 0)) {
/*
@@ -520,34 +521,32 @@ ValidateFormat(
* and/or numVars != 0), then too many vars were given
*/
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"variable is not assigned by any conversion specifiers",
- TCL_STATIC);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "UNASSIGNED", NULL);
goto error;
}
}
- if (nassign != staticAssign) {
- ckfree((char *)nassign);
- }
+ TclStackFree(interp, nassign);
return TCL_OK;
badIndex:
if (gotXpg) {
- Tcl_SetResult(interp, "\"%n$\" argument index out of range",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"%n$\" argument index out of range", -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "INDEXRANGE", NULL);
} else {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"different numbers of variable names and field specifiers",
- TCL_STATIC);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "FIELDVARMISMATCH", NULL);
}
error:
- if (nassign != staticAssign) {
- ckfree((char *)nassign);
- }
+ TclStackFree(interp, nassign);
return TCL_ERROR;
-#undef STATIC_LIST_SIZE
}
/*
@@ -570,16 +569,16 @@ ValidateFormat(
/* ARGSUSED */
int
Tcl_ScanObjCmd(
- ClientData dummy, /* Not used. */
+ 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. */
{
- char *format;
+ const 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;
@@ -592,7 +591,7 @@ Tcl_ScanObjCmd(
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv,
- "string format ?varName varName ...?");
+ "string format ?varName ...?");
return TCL_ERROR;
}
@@ -612,7 +611,7 @@ Tcl_ScanObjCmd(
*/
if (totalVars > 0) {
- objs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj*) * totalVars);
+ objs = ckalloc(sizeof(Tcl_Obj *) * totalVars);
for (i = 0; i < totalVars; i++) {
objs[i] = NULL;
}
@@ -692,7 +691,7 @@ Tcl_ScanObjCmd(
*/
if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
- width = (int) strtoul(format-1, &format, 10);/* INTL: "C" locale. */
+ width = (int) strtoul(format-1, (char **) &format, 10);/* INTL: "C" locale. */
format += Tcl_UtfToUniChar(format, &ch);
} else {
width = 0;
@@ -728,6 +727,7 @@ Tcl_ScanObjCmd(
if (!(flags & SCAN_SUPPRESS)) {
objPtr = Tcl_NewIntObj(string - baseString);
Tcl_IncrRefCount(objPtr);
+ CLANG_ASSERT(objs);
objs[objIndex++] = objPtr;
}
nconversions++;
@@ -746,17 +746,25 @@ Tcl_ScanObjCmd(
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;
@@ -830,6 +838,7 @@ Tcl_ScanObjCmd(
if (!(flags & SCAN_SUPPRESS)) {
objPtr = Tcl_NewStringObj(string, end-string);
Tcl_IncrRefCount(objPtr);
+ CLANG_ASSERT(objs);
objs[objIndex++] = objPtr;
}
string = end;
@@ -880,6 +889,7 @@ Tcl_ScanObjCmd(
if (!(flags & SCAN_SUPPRESS)) {
objPtr = Tcl_NewIntObj((int)sch);
Tcl_IncrRefCount(objPtr);
+ CLANG_ASSERT(objs);
objs[objIndex++] = objPtr;
}
break;
@@ -915,7 +925,7 @@ Tcl_ScanObjCmd(
if (flags & SCAN_LONGER) {
if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
wideValue = ~(Tcl_WideUInt)0 >> 1; /* WIDE_MAX */
- if (Tcl_GetString(objPtr)[0] == '-') {
+ if (TclGetString(objPtr)[0] == '-') {
wideValue++; /* WIDE_MAX + 1 = WIDE_MIN */
}
}
@@ -927,8 +937,8 @@ Tcl_ScanObjCmd(
Tcl_SetWideIntObj(objPtr, wideValue);
}
} else if (!(flags & SCAN_BIG)) {
- if (Tcl_GetLongFromObj(NULL, objPtr, &value) != TCL_OK) {
- if (Tcl_GetString(objPtr)[0] == '-') {
+ if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) {
+ if (TclGetString(objPtr)[0] == '-') {
value = LONG_MIN;
} else {
value = LONG_MAX;
@@ -975,7 +985,7 @@ Tcl_ScanObjCmd(
if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
#ifdef ACCEPT_NAN
if (objPtr->typePtr == &tclDoubleType) {
- dValue = objPtr->internalRep.doubleValue;
+ dvalue = objPtr->internalRep.doubleValue;
} else
#endif
{
@@ -984,6 +994,7 @@ Tcl_ScanObjCmd(
}
}
Tcl_SetDoubleObj(objPtr, dvalue);
+ CLANG_ASSERT(objs);
objs[objIndex++] = objPtr;
string = end;
}
@@ -1005,9 +1016,14 @@ Tcl_ScanObjCmd(
continue;
}
result++;
- if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], 0) == NULL) {
- Tcl_AppendResult(interp, "couldn't set variable \"",
- TclGetString(objv[i+3]), "\"", NULL);
+
+ /*
+ * 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]);
@@ -1033,7 +1049,7 @@ Tcl_ScanObjCmd(
}
}
if (objs != NULL) {
- ckfree((char*) objs);
+ ckfree(objs);
}
if (code == TCL_OK) {
if (underflow && (nconversions == 0)) {
generated by cgit v0.12 at 2025-10-18 21:24:45 (GMT)