diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | doc/GetInt.3 | 44 | ||||
| -rw-r--r-- | generic/tclGet.c | 206 |
3 files changed, 80 insertions, 178 deletions
@@ -1,3 +1,11 @@ +2005-04-21 Don Porter <dgp@users.sourceforge.net> + + * doc/GetInt.3: Convert argument "string" to "str" to agree with code. + Also clarified a few details on int and double formats. + * generic/tclGet.c: Radical code simplification. Converted most + Tcl_GetFoo() routines into wrappers around Tcl_GetFooFromObj(). + Reduces code duplication, and the resulting potential for inconsistency. + 2005-04-20 Don Porter <dgp@users.sourceforge.net> * generic/tclGet.c (Tcl_GetInt): Corrected error that did not diff --git a/doc/GetInt.3 b/doc/GetInt.3 index bd1475e..573a596 100644 --- a/doc/GetInt.3 +++ b/doc/GetInt.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: GetInt.3,v 1.7 2004/10/07 15:15:38 dkf Exp $ +'\" RCS: @(#) $Id: GetInt.3,v 1.8 2005/04/21 14:23:48 dgp Exp $ '\" .so man.macros .TH Tcl_GetInt 3 "" Tcl "Tcl Library Procedures" @@ -17,62 +17,64 @@ Tcl_GetInt, Tcl_GetDouble, Tcl_GetBoolean \- convert from string to integer, dou \fB#include <tcl.h>\fR .sp int -\fBTcl_GetInt\fR(\fIinterp, string, intPtr\fR) +\fBTcl_GetInt\fR(\fIinterp, str, intPtr\fR) .sp int -\fBTcl_GetDouble\fR(\fIinterp, string, doublePtr\fR) +\fBTcl_GetDouble\fR(\fIinterp, str, doublePtr\fR) .sp int -\fBTcl_GetBoolean\fR(\fIinterp, string, boolPtr\fR) +\fBTcl_GetBoolean\fR(\fIinterp, str, boolPtr\fR) .SH ARGUMENTS .AS Tcl_Interp *doublePtr out .AP Tcl_Interp *interp in Interpreter to use for error reporting. -.AP "const char" *string in +.AP "const char" *str in Textual value to be converted. .AP int *intPtr out -Points to place to store integer value converted from \fIstring\fR. +Points to place to store integer value converted from \fIstr\fR. .AP double *doublePtr out Points to place to store double-precision floating-point -value converted from \fIstring\fR. +value converted from \fIstr\fR. .AP int *boolPtr out -Points to place to store boolean value (0 or 1) converted from \fIstring\fR. +Points to place to store boolean value (0 or 1) converted from \fIstr\fR. .BE .SH DESCRIPTION .PP These procedures convert from strings to integers or double-precision floating-point values or booleans (represented as 0- or 1-valued -integers). Each of the procedures takes a \fIstring\fR argument, +integers). Each of the procedures takes a \fIstr\fR argument, converts it to an internal form of a particular type, and stores the converted value at the location indicated by the procedure's third argument. If all goes well, each of the procedures returns -\fBTCL_OK\fR. If \fIstring\fR doesn't have the proper syntax for the +\fBTCL_OK\fR. If \fIstr\fR doesn't have the proper syntax for the desired type then \fBTCL_ERROR\fR is returned, an error message is left in the interpreter's result, and nothing is stored at *\fIintPtr\fR or *\fIdoublePtr\fR or *\fIboolPtr\fR. .PP -\fBTcl_GetInt\fR expects \fIstring\fR to consist of a collection +\fBTcl_GetInt\fR expects \fIstr\fR to consist of a collection of integer digits, optionally signed and optionally preceded by -white space. If the first two characters of \fIstring\fR are ``0x'' -then \fIstring\fR is expected to be in hexadecimal form; otherwise, -if the first character of \fIstring\fR is ``0'' then \fIstring\fR -is expected to be in octal form; otherwise, \fIstring\fR is +white space. If the first two characters of \fIstr\fR +after the optional white space and sign are ``0x'' +then \fIstr\fR is expected to be in hexadecimal form; otherwise, +if the first such character is ``0'' then \fIstr\fR +is expected to be in octal form; otherwise, \fIstr\fR is expected to be in decimal form. .PP -\fBTcl_GetDouble\fR expects \fIstring\fR to consist of a floating-point +\fBTcl_GetDouble\fR expects \fIstr\fR to consist of a floating-point number, which is: white space; a sign; a sequence of digits; a -decimal point; a sequence of digits; the letter ``e''; and a -signed decimal exponent. Any of the fields may be omitted, except that +decimal point; a sequence of digits; the letter ``e''; a +signed decimal exponent ; and more white space. +Any of the fields may be omitted, except that the digits either before or after the decimal point must be present and if the ``e'' is present then it must be followed by the exponent number. .PP -\fBTcl_GetBoolean\fR expects \fIstring\fR to specify a boolean -value. If \fIstring\fR is any of \fB0\fR, \fBfalse\fR, +\fBTcl_GetBoolean\fR expects \fIstr\fR to specify a boolean +value. If \fIstr\fR is any of \fB0\fR, \fBfalse\fR, \fBno\fR, or \fBoff\fR, then \fBTcl_GetBoolean\fR stores a zero value at \fI*boolPtr\fR. -If \fIstring\fR is any of \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR, +If \fIstr\fR is any of \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR, then 1 is stored at \fI*boolPtr\fR. Any of these values may be abbreviated, and upper-case spellings are also acceptable. diff --git a/generic/tclGet.c b/generic/tclGet.c index 6a56647..06f84e0 100644 --- a/generic/tclGet.c +++ b/generic/tclGet.c @@ -11,11 +11,10 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclGet.c,v 1.10 2005/04/20 16:04:19 dgp Exp $ + * RCS: @(#) $Id: tclGet.c,v 1.11 2005/04/21 14:23:48 dgp Exp $ */ #include "tclInt.h" -#include <math.h> /* @@ -38,80 +37,20 @@ */ int -Tcl_GetInt(interp, string, intPtr) +Tcl_GetInt(interp, str, 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. */ + CONST char *str; /* String containing a (possibly signed) + * integer in a form acceptable to strtoul. */ int *intPtr; /* Place to store converted result. */ { - 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; - } - - /* - * 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. - */ - - 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; - } - *intPtr = (int) i; - return TCL_OK; + Tcl_Obj obj; + + obj.refCount = 1; + obj.bytes = (char *) str; + obj.length = strlen(str); + obj.typePtr = NULL; + + return Tcl_GetIntFromObj(interp, &obj, intPtr); } /* @@ -137,64 +76,22 @@ Tcl_GetInt(interp, string, intPtr) */ int -TclGetLong(interp, string, longPtr) +TclGetLong(interp, str, longPtr) Tcl_Interp *interp; /* Interpreter used for error reporting * if not NULL. */ - CONST char *string; /* String containing a (possibly signed) + CONST char *str; /* String containing a (possibly signed) * long integer in a form acceptable to * strtoul. */ long *longPtr; /* Place to store converted long result. */ { - char *end; - CONST char *p = string; - long i; + Tcl_Obj obj; - /* - * Note: don't depend on strtoul to handle sign characters; it won't - * in some implementations. - */ + obj.refCount = 1; + obj.bytes = (char *) str; + obj.length = strlen(str); + obj.typePtr = NULL; - 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; - } - while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */ - end++; - } - if (*end != 0) { - goto badInteger; - } - *longPtr = i; - return TCL_OK; + return Tcl_GetLongFromObj(interp, &obj, longPtr); } /* @@ -218,40 +115,20 @@ TclGetLong(interp, string, longPtr) */ int -Tcl_GetDouble(interp, string, doublePtr) +Tcl_GetDouble(interp, str, doublePtr) Tcl_Interp *interp; /* Interpreter used for error reporting. */ - CONST char *string; /* String containing a floating-point number + CONST char *str; /* String containing a floating-point number * in a form acceptable to strtod. */ double *doublePtr; /* Place to store converted result. */ { - char *end; - double d; + Tcl_Obj obj; - 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++; - } - if (*end != 0) { - goto badDouble; - } - *doublePtr = d; - return TCL_OK; + obj.refCount = 1; + obj.bytes = (char *) str; + obj.length = strlen(str); + obj.typePtr = NULL; + + return Tcl_GetDoubleFromObj(interp, &obj, doublePtr); } /* @@ -275,14 +152,26 @@ Tcl_GetDouble(interp, string, doublePtr) */ int -Tcl_GetBoolean(interp, string, boolPtr) +Tcl_GetBoolean(interp, str, boolPtr) Tcl_Interp *interp; /* Interpreter used for error reporting. */ - CONST char *string; /* String containing a boolean number + CONST char *str; /* 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. */ { + /* + * Can't use this (yet) due to Bug 1187123. + * + Tcl_Obj obj; + + obj.refCount = 1; + obj.bytes = (char *) str; + obj.length = strlen(str); + obj.typePtr = NULL; + + return Tcl_GetBooleanFromObj(interp, &obj, boolPtr); + */ int i; char lowerCase[10], c; size_t length; @@ -293,7 +182,7 @@ Tcl_GetBoolean(interp, string, boolPtr) */ for (i = 0; i < 9; i++) { - c = string[i]; + c = str[i]; if (c == 0) { break; } @@ -329,8 +218,11 @@ Tcl_GetBoolean(interp, string, boolPtr) } else { badBoolean: if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, "expected boolean value but got \"", - string, "\"", (char *) NULL); + Tcl_Obj *msg = + Tcl_NewStringObj("expected boolean value but got \"", -1); + TclAppendLimitedToObj(msg, str, -1, 50, ""); + Tcl_AppendToObj(msg, "\"", -1); + Tcl_SetObjResult(interp, msg); } return TCL_ERROR; } |