diff options
Diffstat (limited to 'generic/tclGet.c')
| -rw-r--r-- | generic/tclGet.c | 347 |
1 files changed, 241 insertions, 106 deletions
diff --git a/generic/tclGet.c b/generic/tclGet.c index 28734d1..c16da0d 100644 --- a/generic/tclGet.c +++ b/generic/tclGet.c @@ -1,18 +1,21 @@ -/* +/* * tclGet.c -- * - * This file contains functions to convert strings into other forms, like - * integers or floating-point numbers or booleans, doing syntax checking - * along the way. + * This file contains procedures to convert strings into + * other forms, like integers or floating-point numbers or + * booleans, doing syntax checking along the way. * * Copyright (c) 1990-1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * 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 "tclPort.h" +#include <math.h> + /* *---------------------------------------------------------------------- @@ -22,10 +25,10 @@ * Given a string, produce the corresponding integer value. * * Results: - * The return value is normally TCL_OK; in this case *intPtr will be set - * to the integer value equivalent to src. If src is improperly formed - * then TCL_ERROR is returned and an error message will be left in the - * interp's result. + * The return value is normally TCL_OK; in this case *intPtr + * will be set to the integer value equivalent to string. If + * string is improperly formed then TCL_ERROR is returned and + * an error message will be left in the interp's result. * * Side effects: * None. @@ -34,27 +37,80 @@ */ int -Tcl_GetInt( - Tcl_Interp *interp, /* Interpreter to use for error reporting. */ - CONST char *src, /* String containing a (possibly signed) - * integer in a form acceptable to - * Tcl_GetIntFromObj(). */ - int *intPtr) /* Place to store converted result. */ +Tcl_GetInt(interp, string, intPtr) + Tcl_Interp *interp; /* Interpreter to use for error reporting. */ + CONST char *string; /* String containing a (possibly signed) + * integer in a form acceptable to strtol. */ + int *intPtr; /* Place to store converted result. */ { - Tcl_Obj obj; - int code; + char *end; + CONST char *p = string; + long i; + + /* + * Note: use strtoul instead of strtol for integer conversions + * to allow full-size unsigned numbers, but don't depend on strtoul + * to handle sign characters; it won't in some implementations. + */ + + errno = 0; +#ifdef TCL_STRTOUL_SIGN_CHECK + /* + * This special sign check actually causes bad numbers to be allowed + * when strtoul. I can't find a strtoul that doesn't validly handle + * signed characters, and the C standard implies that this is all + * unnecessary. [Bug #634856] + */ + for ( ; isspace(UCHAR(*p)); p++) { /* INTL: ISO space. */ + /* Empty loop body. */ + } + if (*p == '-') { + p++; + i = -((long)strtoul(p, &end, 0)); /* INTL: Tcl source. */ + } else if (*p == '+') { + p++; + i = strtoul(p, &end, 0); /* INTL: Tcl source. */ + } else +#else + i = strtoul(p, &end, 0); /* INTL: Tcl source. */ +#endif + if (end == p) { + badInteger: + if (interp != (Tcl_Interp *) NULL) { + Tcl_AppendResult(interp, "expected integer but got \"", string, + "\"", (char *) NULL); + TclCheckBadOctal(interp, string); + } + return TCL_ERROR; + } - obj.refCount = 1; - obj.bytes = (char *) src; - obj.length = strlen(src); - obj.typePtr = NULL; + /* + * The second test below is needed on platforms where "long" is + * larger than "int" to detect values that fit in a long but not in + * an int. + */ - code = Tcl_GetIntFromObj(interp, &obj, intPtr); - if (obj.refCount > 1) { - Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); + if ((errno == ERANGE) +#if (LONG_MAX > INT_MAX) + || (i > UINT_MAX) || (i < -(long)UINT_MAX) +#endif + ) { + if (interp != (Tcl_Interp *) NULL) { + Tcl_SetResult(interp, "integer value too large to represent", + TCL_STATIC); + Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", + Tcl_GetStringResult(interp), (char *) NULL); + } + return TCL_ERROR; + } + while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */ + end++; + } + if (*end != 0) { + goto badInteger; } - TclFreeIntRep(&obj); - return code; + *intPtr = (int) i; + return TCL_OK; } /* @@ -62,15 +118,16 @@ Tcl_GetInt( * * TclGetLong -- * - * Given a string, produce the corresponding long integer value. This - * routine is a version of Tcl_GetInt but returns a "long" instead of an - * "int" (a difference that matters on 64-bit architectures). + * Given a string, produce the corresponding long integer value. + * This routine is a version of Tcl_GetInt but returns a "long" + * instead of an "int". * * Results: - * The return value is normally TCL_OK; in this case *longPtr will be set - * to the long integer value equivalent to src. If src is improperly - * formed then TCL_ERROR is returned and an error message will be left in - * the interp's result if interp is non-NULL. + * The return value is normally TCL_OK; in this case *longPtr + * will be set to the long integer value equivalent to string. If + * string is improperly formed then TCL_ERROR is returned and + * an error message will be left in the interp's result if interp + * is non-NULL. * * Side effects: * None. @@ -79,28 +136,64 @@ Tcl_GetInt( */ int -TclGetLong( - Tcl_Interp *interp, /* Interpreter used for error reporting if not - * NULL. */ - CONST char *src, /* String containing a (possibly signed) long - * integer in a form acceptable to - * Tcl_GetLongFromObj(). */ - long *longPtr) /* Place to store converted long result. */ +TclGetLong(interp, string, longPtr) + Tcl_Interp *interp; /* Interpreter used for error reporting + * if not NULL. */ + CONST char *string; /* String containing a (possibly signed) + * long integer in a form acceptable to + * strtoul. */ + long *longPtr; /* Place to store converted long result. */ { - Tcl_Obj obj; - int code; + char *end; + CONST char *p = string; + long i; - obj.refCount = 1; - obj.bytes = (char *) src; - obj.length = strlen(src); - obj.typePtr = NULL; + /* + * Note: don't depend on strtoul to handle sign characters; it won't + * in some implementations. + */ - code = Tcl_GetLongFromObj(interp, &obj, longPtr); - if (obj.refCount > 1) { - Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); + errno = 0; +#ifdef TCL_STRTOUL_SIGN_CHECK + for ( ; isspace(UCHAR(*p)); p++) { /* INTL: ISO space. */ + /* Empty loop body. */ + } + if (*p == '-') { + p++; + i = -(int)strtoul(p, &end, 0); /* INTL: Tcl source. */ + } else if (*p == '+') { + p++; + i = strtoul(p, &end, 0); /* INTL: Tcl source. */ + } else +#else + i = strtoul(p, &end, 0); /* INTL: Tcl source. */ +#endif + if (end == p) { + badInteger: + if (interp != (Tcl_Interp *) NULL) { + Tcl_AppendResult(interp, "expected integer but got \"", string, + "\"", (char *) NULL); + TclCheckBadOctal(interp, string); + } + return TCL_ERROR; + } + if (errno == ERANGE) { + if (interp != (Tcl_Interp *) NULL) { + Tcl_SetResult(interp, "integer value too large to represent", + TCL_STATIC); + Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", + Tcl_GetStringResult(interp), (char *) NULL); + } + return TCL_ERROR; } - TclFreeIntRep(&obj); - return code; + while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */ + end++; + } + if (*end != 0) { + goto badInteger; + } + *longPtr = i; + return TCL_OK; } /* @@ -112,10 +205,10 @@ TclGetLong( * floating-point value. * * Results: - * The return value is normally TCL_OK; in this case *doublePtr will be - * set to the double-precision value equivalent to src. If src is - * improperly formed then TCL_ERROR is returned and an error message will - * be left in the interp's result. + * The return value is normally TCL_OK; in this case *doublePtr + * will be set to the double-precision value equivalent to string. + * If string is improperly formed then TCL_ERROR is returned and + * an error message will be left in the interp's result. * * Side effects: * None. @@ -124,27 +217,40 @@ TclGetLong( */ int -Tcl_GetDouble( - Tcl_Interp *interp, /* Interpreter used for error reporting. */ - CONST char *src, /* String containing a floating-point number - * in a form acceptable to - * Tcl_GetDoubleFromObj(). */ - double *doublePtr) /* Place to store converted result. */ +Tcl_GetDouble(interp, string, doublePtr) + Tcl_Interp *interp; /* Interpreter used for error reporting. */ + CONST char *string; /* String containing a floating-point number + * in a form acceptable to strtod. */ + double *doublePtr; /* Place to store converted result. */ { - Tcl_Obj obj; - int code; - - obj.refCount = 1; - obj.bytes = (char *) src; - obj.length = strlen(src); - obj.typePtr = NULL; + char *end; + double d; - code = Tcl_GetDoubleFromObj(interp, &obj, doublePtr); - if (obj.refCount > 1) { - Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); + errno = 0; + d = strtod(string, &end); /* INTL: Tcl source. */ + if (end == string) { + badDouble: + if (interp != (Tcl_Interp *) NULL) { + Tcl_AppendResult(interp, + "expected floating-point number but got \"", + string, "\"", (char *) NULL); + } + return TCL_ERROR; + } + if (errno != 0 && (d == HUGE_VAL || d == -HUGE_VAL || d == 0)) { + if (interp != (Tcl_Interp *) NULL) { + TclExprFloatError(interp, d); + } + return TCL_ERROR; + } + while ((*end != 0) && isspace(UCHAR(*end))) { /* INTL: ISO space. */ + end++; } - TclFreeIntRep(&obj); - return code; + if (*end != 0) { + goto badDouble; + } + *doublePtr = d; + return TCL_OK; } /* @@ -152,14 +258,14 @@ Tcl_GetDouble( * * Tcl_GetBoolean -- * - * Given a string, return a 0/1 boolean value corresponding to the - * string. + * Given a string, return a 0/1 boolean value corresponding + * to the string. * * Results: - * The return value is normally TCL_OK; in this case *boolPtr will be set - * to the 0/1 value equivalent to src. If src is improperly formed then - * TCL_ERROR is returned and an error message will be left in the - * interp's result. + * The return value is normally TCL_OK; in this case *boolPtr + * will be set to the 0/1 value equivalent to string. If + * string is improperly formed then TCL_ERROR is returned and + * an error message will be left in the interp's result. * * Side effects: * None. @@ -168,35 +274,64 @@ Tcl_GetDouble( */ int -Tcl_GetBoolean( - Tcl_Interp *interp, /* Interpreter used for error reporting. */ - CONST char *src, /* String containing one of the boolean values - * 1, 0, true, false, yes, no, on off. */ - int *boolPtr) /* Place to store converted result, which will - * be 0 or 1. */ +Tcl_GetBoolean(interp, string, boolPtr) + Tcl_Interp *interp; /* Interpreter used for error reporting. */ + CONST char *string; /* String containing a boolean number + * specified either as 1/0 or true/false or + * yes/no. */ + int *boolPtr; /* Place to store converted result, which + * will be 0 or 1. */ { - Tcl_Obj obj; - int code; + int i; + char lowerCase[10], c; + size_t length; - obj.refCount = 1; - obj.bytes = (char *) src; - obj.length = strlen(src); - obj.typePtr = NULL; + /* + * Convert the input string to all lower-case. + * INTL: This code will work on UTF strings. + */ - code = Tcl_ConvertToType(interp, &obj, &tclBooleanType); - if (obj.refCount > 1) { - Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); + for (i = 0; i < 9; i++) { + c = string[i]; + if (c == 0) { + break; + } + if ((c >= 'A') && (c <= 'Z')) { + c += (char) ('a' - 'A'); + } + lowerCase[i] = c; } - if (code == TCL_OK) { - *boolPtr = obj.internalRep.longValue; + lowerCase[i] = 0; + + length = strlen(lowerCase); + c = lowerCase[0]; + if ((c == '0') && (lowerCase[1] == '\0')) { + *boolPtr = 0; + } else if ((c == '1') && (lowerCase[1] == '\0')) { + *boolPtr = 1; + } else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) { + *boolPtr = 1; + } else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) { + *boolPtr = 0; + } else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) { + *boolPtr = 1; + } else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) { + *boolPtr = 0; + } else if ((c == 'o') && (length >= 2)) { + if (strncmp(lowerCase, "on", length) == 0) { + *boolPtr = 1; + } else if (strncmp(lowerCase, "off", length) == 0) { + *boolPtr = 0; + } else { + goto badBoolean; + } + } else { + badBoolean: + if (interp != (Tcl_Interp *) NULL) { + Tcl_AppendResult(interp, "expected boolean value but got \"", + string, "\"", (char *) NULL); + } + return TCL_ERROR; } - return code; + return TCL_OK; } - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ |