diff options
Diffstat (limited to 'generic/tclObj.c')
| -rw-r--r-- | generic/tclObj.c | 289 |
1 files changed, 142 insertions, 147 deletions
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); } |