diff options
author | dgp <dgp@noemail.net> | 2005-04-21 20:24:01 (GMT) |
---|---|---|
committer | dgp <dgp@noemail.net> | 2005-04-21 20:24:01 (GMT) |
commit | 904dd492f50a4989858fc398650e875bb522c74b (patch) | |
tree | d1b5923569a757d01be4827253f687dbd07a8163 /generic | |
parent | b8646ce1d93aafed57919057dba2fa965c03e41f (diff) | |
download | tcl-904dd492f50a4989858fc398650e875bb522c74b.zip tcl-904dd492f50a4989858fc398650e875bb522c74b.tar.gz tcl-904dd492f50a4989858fc398650e875bb522c74b.tar.bz2 |
* generic/tclGet.c: Radical code simplification. Converted
Tcl_GetFoo() routines into wrappers around Tcl_GetFooFromObj().
Reduces code duplication, and the resulting potential for inconsistency.
* generic/tclObj.c: Several changes:
- Fixed Tcl_GetBooleanFromObj to agree with its documentation and
with Tcl_GetBoolean, accepting only "0" and "1" and not other
numeric strings. [Bug 1187123]
- Added new private routine TclGetTruthValueFromObj to perform
the more permissive conversion of numeric values to boolean
that is needed by the [expr] machinery.
* generic/tclInt.h (TclGetTruthValueFromObj): New routine.
* generic/tclExecute.c: Updated callers to call new routine.
* tests/obj.test: Corrected bad tests that actually expected
values like "47" and "0xac" to be accepted as booleans.
FossilOrigin-Name: c5a5c3f411996512fd101be94fa70877fc8e1e88
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclExecute.c | 10 | ||||
-rw-r--r-- | generic/tclGet.c | 87 | ||||
-rw-r--r-- | generic/tclInt.h | 4 | ||||
-rw-r--r-- | generic/tclObj.c | 289 |
4 files changed, 174 insertions, 216 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 8208752..961566c 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.182 2005/04/15 02:38:39 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.183 2005/04/21 20:24:11 dgp Exp $ */ #include "tclInt.h" @@ -2539,7 +2539,7 @@ TclExecuteByteCode(interp, codePtr) */ int b1; - result = Tcl_GetBooleanFromObj(interp, valuePtr, &b1); + result = TclGetTruthValueFromObj(interp, valuePtr, &b1); if (result != TCL_OK) { if ((*pc == INST_JUMP_FALSE1) || (*pc == INST_JUMP_FALSE4)) { jmpOffset[1] = jmpOffset[0]; @@ -2616,7 +2616,7 @@ TclExecuteByteCode(interp, codePtr) i1 = (w != W0); } } else { - result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL, + result = TclGetTruthValueFromObj((Tcl_Interp *) NULL, valuePtr, &i1); i1 = (i1 != 0); } @@ -2647,7 +2647,7 @@ TclExecuteByteCode(interp, codePtr) i2 = (w != W0); } } else { - result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL, value2Ptr, &i2); + result = TclGetTruthValueFromObj((Tcl_Interp *) NULL, value2Ptr, &i2); } if (result != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr), @@ -4302,7 +4302,7 @@ TclExecuteByteCode(interp, codePtr) valuePtr, &d); } if (result == TCL_ERROR && *pc == INST_LNOT) { - result = Tcl_GetBooleanFromObj((Tcl_Interp *)NULL, + result = TclGetTruthValueFromObj((Tcl_Interp *)NULL, valuePtr, &boolvar); i = (long)boolvar; /* i is long, not int! */ } diff --git a/generic/tclGet.c b/generic/tclGet.c index 06f84e0..bad8289 100644 --- a/generic/tclGet.c +++ b/generic/tclGet.c @@ -11,7 +11,7 @@ * 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.11 2005/04/21 14:23:48 dgp Exp $ + * RCS: @(#) $Id: tclGet.c,v 1.12 2005/04/21 20:24:13 dgp Exp $ */ #include "tclInt.h" @@ -44,13 +44,18 @@ Tcl_GetInt(interp, str, intPtr) int *intPtr; /* Place to store converted result. */ { Tcl_Obj obj; + int code; obj.refCount = 1; obj.bytes = (char *) str; obj.length = strlen(str); obj.typePtr = NULL; - return Tcl_GetIntFromObj(interp, &obj, intPtr); + code = Tcl_GetIntFromObj(interp, &obj, intPtr); + if (obj.refCount > 1) { + Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); + } + return code; } /* @@ -85,13 +90,18 @@ TclGetLong(interp, str, longPtr) long *longPtr; /* Place to store converted long result. */ { Tcl_Obj obj; + int code; obj.refCount = 1; obj.bytes = (char *) str; obj.length = strlen(str); obj.typePtr = NULL; - return Tcl_GetLongFromObj(interp, &obj, longPtr); + code = Tcl_GetLongFromObj(interp, &obj, longPtr); + if (obj.refCount > 1) { + Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); + } + return code; } /* @@ -122,13 +132,18 @@ Tcl_GetDouble(interp, str, doublePtr) double *doublePtr; /* Place to store converted result. */ { Tcl_Obj obj; + int code; obj.refCount = 1; obj.bytes = (char *) str; obj.length = strlen(str); obj.typePtr = NULL; - return Tcl_GetDoubleFromObj(interp, &obj, doublePtr); + code = Tcl_GetDoubleFromObj(interp, &obj, doublePtr); + if (obj.refCount > 1) { + Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); + } + return code; } /* @@ -160,71 +175,17 @@ Tcl_GetBoolean(interp, str, boolPtr) 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; + int code; 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; - - /* - * Convert the input string to all lower-case. - * INTL: This code will work on UTF strings. - */ - - for (i = 0; i < 9; i++) { - c = str[i]; - if (c == 0) { - break; - } - if ((c >= 'A') && (c <= 'Z')) { - c += (char) ('a' - 'A'); - } - lowerCase[i] = c; - } - 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_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; + code = Tcl_GetBooleanFromObj(interp, &obj, boolPtr); + if (obj.refCount > 1) { + Tcl_Panic("invalid sharing of Tcl_Obj on C stack"); } - return TCL_OK; + return code; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 7777cfd..68c2827 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.223 2005/04/19 16:32:55 dgp Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.224 2005/04/21 20:24:13 dgp Exp $ */ #ifndef _TCLINT @@ -1892,6 +1892,8 @@ MODULE_SCOPE int TclGetNamespaceFromObj _ANSI_ARGS_(( MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue _ANSI_ARGS_ (( ProcessGlobalValue *pgvPtr)); +MODULE_SCOPE int TclGetTruthValueFromObj _ANSI_ARGS_ (( + Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr)); MODULE_SCOPE int TclGlob _ANSI_ARGS_((Tcl_Interp *interp, char *pattern, Tcl_Obj *unquotedPrefix, int globFlags, Tcl_GlobTypeData* types)); diff --git a/generic/tclObj.c b/generic/tclObj.c index 4c6b448..96d5227 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclObj.c,v 1.78 2005/04/21 15:49:47 dgp Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.79 2005/04/21 20:24:13 dgp Exp $ */ #include "tclInt.h" @@ -1234,8 +1234,11 @@ Tcl_SetBooleanObj(objPtr, boolValue) * Tcl_GetBooleanFromObj -- * * Attempt to return a boolean from the Tcl object "objPtr". If the - * object is not already a boolean, an attempt will be made to convert - * it to one. + * object is not already of the "boolean" Tcl_ObjType, an attempt + * will be made to convert it to one. + * + * Note that only exact boolean values are recognized, not all + * numeric values (use TclGetTruthValueFromObj() for that). * * Results: * The return value is a standard Tcl object result. If an error occurs @@ -1272,6 +1275,67 @@ Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) /* *---------------------------------------------------------------------- * + * TclGetTruthValueFromObj -- + * + * Attempt to return a boolean from the Tcl object "objPtr". This + * includes conversion from any of Tcl's numeric types. + * + * Results: + * The return value is a standard Tcl object result. If an error occurs + * during conversion, an error message is left in the interpreter's + * result unless "interp" is NULL. + * + * Side effects: + * The intrep of *objPtr may be changed. + * + *---------------------------------------------------------------------- + */ + +int +TclGetTruthValueFromObj(interp, objPtr, boolPtr) + Tcl_Interp *interp; /* Used for error reporting if not NULL. */ + register Tcl_Obj *objPtr; /* The object from which to get boolean. */ + register int *boolPtr; /* Place to store resulting boolean. */ +{ + double d; + long l; + Tcl_WideInt w; + + /* + * The following call retrieves a numeric value without shimmering + * away any existing numeric intrep Tcl_ObjTypes. + */ + if (Tcl_GetDoubleFromObj(NULL, objPtr, &d) == TCL_OK) { + *boolPtr = (d != 0.0); + return TCL_OK; + } + /* + * Value didn't already have a numeric intrep, but perhaps we can + * generate one. Try a long value first... + */ + if (Tcl_GetLongFromObj(NULL, objPtr, &l) == TCL_OK) { + *boolPtr = (l != 0); + return TCL_OK; + } +#ifndef TCL_WIDE_INT_IS_LONG + /* + * ...then a wide. Check in that order so that we don't promote + * anything to wide unnecessarily. + */ + if (Tcl_GetWideIntFromObj(NULL, objPtr, &w) == TCL_OK) { + *boolPtr = (w != 0); + return TCL_OK; + } +#endif + /* + * Finally, check for the string values like "yes" + */ + return Tcl_GetBooleanFromObj(interp, objPtr, boolPtr); +} + +/* + *---------------------------------------------------------------------- + * * SetBooleanFromAny -- * * Attempt to generate a boolean internal form for the Tcl object @@ -1294,69 +1358,87 @@ SetBooleanFromAny(interp, objPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr; /* The object to convert. */ { - char *string, *end; - register char c; - char lowerCase[8]; - int newBool, length; - register int i; - - /* - * Get the string representation. Make it up-to-date if necessary. - */ - - string = Tcl_GetStringFromObj(objPtr, &length); + char *str, lowerCase[6]; + int i, newBool, length; /* - * Use the obvious shortcuts for numerical values; if objPtr is not - * of numerical type, parse its string rep. + * For some "pure" numeric Tcl_ObjTypes (no string rep), we can + * determine whether a boolean conversion is possible without + * generating the string rep. */ - if (objPtr->typePtr == &tclIntType) { - newBool = (objPtr->internalRep.longValue != 0); - goto goodBoolean; - } else if (objPtr->typePtr == &tclDoubleType) { - newBool = (objPtr->internalRep.doubleValue != 0.0); - goto goodBoolean; - } else if (objPtr->typePtr == &tclWideIntType) { - newBool = (objPtr->internalRep.wideValue != 0); - goto goodBoolean; + if (objPtr->bytes == NULL) { + if (objPtr->typePtr == &tclDoubleType) { + goto badBoolean; + } + if (objPtr->typePtr == &tclIntType) { + long l = objPtr->internalRep.longValue; + switch (l) { + case 0: case 1: + newBool = (int)l; + goto goodBoolean; + } + goto badBoolean; + } + if (objPtr->typePtr == &tclWideIntType) { + Tcl_WideInt w = objPtr->internalRep.wideValue; + switch (w) { + case 0: case 1: + newBool = (int)w; + goto goodBoolean; + } + goto badBoolean; + } } /* * Parse the string as a boolean. We use an implementation here * that doesn't report errors in interp if interp is NULL. - * - * First we define a macro to factor out the to-lower-case code. - * The len parameter is the maximum number of characters to copy - * to allow the following comparisons to proceed correctly, - * including (properly) the trailing \0 character. This is done - * in multiple places so the number of copying steps is minimised - * and only performed when needed. */ -#define SBFA_TOLOWER(len) \ - for (i=0 ; i<(len) && i<length ; i++) { \ - c = string[i]; \ - if (c & 0x80) { \ - goto badBoolean; \ - } \ - if (Tcl_UniCharIsUpper(UCHAR(c))) { \ - c = (char) Tcl_UniCharToLower(UCHAR(c)); \ - } \ - lowerCase[i] = c; \ - } \ - lowerCase[i] = 0; - - switch (string[0]) { - case 'y': case 'Y': - /* - * Copy the string converting its characters to lower case. - * This also weeds out international characters so we can - * safely operate on single bytes. - */ + str = Tcl_GetStringFromObj(objPtr, &length); + if ((length == 0) || (length > 5)) { + /* longest valid boolean string rep. is "false" */ + goto badBoolean; + } - SBFA_TOLOWER(4); + switch (str[0]) { + case '0': + if (length == 1) { + newBool = 0; + goto goodBoolean; + } + goto badBoolean; + case '1': + if (length == 1) { + newBool = 1; + goto goodBoolean; + } + goto badBoolean; + + } + + /* + * Force to lower case for case-insensitive detection. + * Filter out known invalid characters at the same time. + */ + for (i=0; i < length; i++) { + char c = str[i]; + switch (c) { + case 'A': case 'E': case 'F': case 'L': case 'N': + case 'O': case 'R': case 'S': case 'T': case 'U': case 'Y': + lowerCase[i] = c + (char) ('a' - 'A'); break; + case 'a': case 'e': case 'f': case 'l': case 'n': + case 'o': case 'r': case 's': case 't': case 'u': case 'y': + lowerCase[i] = c; break; + default: + goto badBoolean; + } + } + lowerCase[length] = 0; + switch (lowerCase[0]) { + case 'y': /* * Checking the 'y' is redundant, but makes the code clearer. */ @@ -1365,32 +1447,28 @@ SetBooleanFromAny(interp, objPtr) goto goodBoolean; } goto badBoolean; - case 'n': case 'N': - SBFA_TOLOWER(3); + case 'n': if (strncmp(lowerCase, "no", (size_t) length) == 0) { newBool = 0; goto goodBoolean; } goto badBoolean; - case 't': case 'T': - SBFA_TOLOWER(5); + case 't': if (strncmp(lowerCase, "true", (size_t) length) == 0) { newBool = 1; goto goodBoolean; } goto badBoolean; - case 'f': case 'F': - SBFA_TOLOWER(6); + case 'f': if (strncmp(lowerCase, "false", (size_t) length) == 0) { newBool = 0; goto goodBoolean; } goto badBoolean; - case 'o': case 'O': + case 'o': if (length < 2) { goto badBoolean; } - SBFA_TOLOWER(4); if (strncmp(lowerCase, "on", (size_t) length) == 0) { newBool = 1; goto goodBoolean; @@ -1399,92 +1477,8 @@ SetBooleanFromAny(interp, objPtr) goto goodBoolean; } goto badBoolean; -#undef SBFA_TOLOWER - case '0': - if (string[1] == '\0') { - newBool = 0; - goto goodBoolean; - } - goto parseNumeric; - case '1': - if (string[1] == '\0') { - newBool = 1; - goto goodBoolean; - } - /* deliberate fall-through */ default: - parseNumeric: - { - double dbl; - /* - * Boolean values can be extracted from ints or doubles. - * Note that we don't use strtoul or strtoull here because - * we don't care about what the value is, just whether it - * is equal to zero or not. - */ -#ifdef TCL_WIDE_INT_IS_LONG - newBool = strtol(string, &end, 0); - if (end != string) { - /* - * Make sure the string has no garbage after the end of - * the int. - */ - while ((end < (string+length)) - && isspace(UCHAR(*end))) { /* INTL: ISO only */ - end++; - } - if (end == (string+length)) { - newBool = (newBool != 0); - goto goodBoolean; - } - } -#else /* !TCL_WIDE_INT_IS_LONG */ - Tcl_WideInt wide = strtoll(string, &end, 0); - if (end != string) { - /* - * Make sure the string has no garbage after the end of - * the wide int. - */ - while ((end < (string+length)) - && isspace(UCHAR(*end))) { /* INTL: ISO only */ - end++; - } - if (end == (string+length)) { - newBool = (wide != Tcl_LongAsWide(0)); - goto goodBoolean; - } - } -#endif /* TCL_WIDE_INT_IS_LONG */ - /* - * Still might be a string containing the characters - * representing an int or double that wasn't handled - * above. This would be a string like "27" or "1.0" that - * is non-zero and not "1". Such a string would result in - * the boolean value true. We try converting to double. If - * that succeeds and the resulting double is non-zero, we - * have a "true". Note that numbers can't have embedded - * NULLs. - */ - - dbl = strtod(string, &end); - if (end == string) { - goto badBoolean; - } - - /* - * Make sure the string has no garbage after the end of - * the double. - */ - - while ((end < (string+length)) - && isspace(UCHAR(*end))) { /* INTL: ISO only */ - end++; - } - if (end != (string+length)) { - goto badBoolean; - } - newBool = (dbl != 0.0); - } + goto badBoolean; } /* @@ -1503,7 +1497,8 @@ SetBooleanFromAny(interp, objPtr) if (interp != NULL) { Tcl_Obj *msg = Tcl_NewStringObj("expected boolean value but got \"", -1); - TclAppendLimitedToObj(msg, string, length, 50, ""); + str = Tcl_GetStringFromObj(objPtr, &length); + TclAppendLimitedToObj(msg, str, length, 50, ""); Tcl_AppendToObj(msg, "\"", -1); Tcl_SetObjResult(interp, msg); } |