diff options
author | hobbs <hobbs> | 1999-12-04 06:15:40 (GMT) |
---|---|---|
committer | hobbs <hobbs> | 1999-12-04 06:15:40 (GMT) |
commit | 78a6d2f842a7ff7465cd0397481a93c78375096f (patch) | |
tree | c153fe1950b58db095afef4ac9ea58a5e73ebb2a /generic/tclExecute.c | |
parent | 5239dbb3790e4d48cee4dad3455a529b18b6c30b (diff) | |
download | tcl-78a6d2f842a7ff7465cd0397481a93c78375096f.zip tcl-78a6d2f842a7ff7465cd0397481a93c78375096f.tar.gz tcl-78a6d2f842a7ff7465cd0397481a93c78375096f.tar.bz2 |
* tests/expr-old.test:
* tests/parseExpr.test:
* tests/string.test:
* generic/tclGet.c:
* generic/tclInt.h:
* generic/tclObj.c:
* generic/tclParseExpr.c:
* generic/tclUtil.c:
* generic/tclExecute.c: added TclCheckBadOctal routine to enhance
error message checking for when users use invalid octal numbers
(like 08), as well as replumbed the Expr*Funcs with a new
VerifyExprObjType to simplify type handling.
* tests/expr.test:
* generic/tclCompile.c: fixed 'bad code length' error for
'expr + {[incr]}' case, with new test case [Bug: 3736]
and seg fault on 'expr + {[error]}' (different cause) that
was caused by a correct optimization that didn't correctly
track how it was modifying the source string in the opt.
The optimization was removed, which means that:
expr 1 + {[string length abc]}
will be not be compiled inline as before, but this should be
written:
expr {1 + [string length abc]}
which will be compiled inline for speed. This prevents
expr 1 + {[mindless error]}
from seg faulting, and only affects optimizations for
degenerate cases [Bug: 3737]
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r-- | generic/tclExecute.c | 388 |
1 files changed, 160 insertions, 228 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index c7e05a4..5262f6b 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -9,7 +9,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.7 1999/06/16 21:56:33 stanton Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.8 1999/12/04 06:15:41 hobbs Exp $ */ #include "tclInt.h" @@ -260,6 +260,8 @@ static void ValidatePcAndStackTop _ANSI_ARGS_(( int stackTop, int stackLowerBound, int stackUpperBound)); #endif +static int VerifyExprObjType _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr)); /* * Table describing the built-in math functions. Entries in this table are @@ -3054,7 +3056,6 @@ IllegalExprOperandType(interp, pc, opndPtr) * with the illegal type. */ { unsigned char opCode = *pc; - int isDouble; Tcl_ResetResult(interp); if ((opndPtr->bytes == NULL) || (opndPtr->length == 0)) { @@ -3062,7 +3063,7 @@ IllegalExprOperandType(interp, pc, opndPtr) "can't use empty string as operand of \"", operatorStrings[opCode - INST_LOR], "\"", (char *) NULL); } else { - isDouble = 1; + char *msg = "non-numeric string"; if (opndPtr->typePtr != &tclDoubleType) { /* * See if the operand can be interpreted as a double in order to @@ -3072,13 +3073,20 @@ IllegalExprOperandType(interp, pc, opndPtr) char *s = Tcl_GetString(opndPtr); double d; - if (Tcl_GetDouble((Tcl_Interp *) NULL, s, &d) != TCL_OK) { - isDouble = 0; + if (Tcl_GetDouble((Tcl_Interp *) NULL, s, &d) == TCL_OK) { + /* + * Make sure that what appears to be a double + * (ie 08) isn't really a bad octal + */ + if (TclCheckBadOctal(NULL, Tcl_GetString(opndPtr))) { + msg = "invalid octal number"; + } else { + msg = "floating-point value"; + } } } Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ", - (isDouble? "floating-point value" : "non-numeric string"), - " as operand of \"", operatorStrings[opCode - INST_LOR], + msg, " as operand of \"", operatorStrings[opCode - INST_LOR], "\"", (char *) NULL); } } @@ -3373,6 +3381,61 @@ GetOpcodeName(pc) /* *---------------------------------------------------------------------- * + * VerifyExprObjType -- + * + * This procedure is called by the math functions to verify that + * the object is either an int or double, coercing it if necessary. + * If an error occurs during conversion, an error message is left + * in the interpreter's result unless "interp" is NULL. + * + * Results: + * TCL_OK if it was int or double, TCL_ERROR otherwise + * + * Side effects: + * objPtr is ensured to be either tclIntType of tclDoubleType. + * + *---------------------------------------------------------------------- + */ + +static int +VerifyExprObjType(interp, objPtr) + Tcl_Interp *interp; /* The interpreter in which to execute the + * function. */ + Tcl_Obj *objPtr; /* Points to the object to type check. */ +{ + if ((objPtr->typePtr == &tclIntType) || + (objPtr->typePtr == &tclDoubleType)) { + return TCL_OK; + } else { + int length, result = TCL_OK; + char *s = Tcl_GetStringFromObj(objPtr, &length); + + if (TclLooksLikeInt(s, length)) { + long i; + result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, objPtr, &i); + } else { + double d; + result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, objPtr, &d); + } + if ((result != TCL_OK) && (interp != NULL)) { + Tcl_ResetResult(interp); + if (TclCheckBadOctal((Tcl_Interp *) NULL, s)) { + Tcl_AppendToObj(Tcl_GetObjResult(interp), + "argument to math function was an invalid octal number", + -1); + } else { + Tcl_AppendToObj(Tcl_GetObjResult(interp), + "argument to math function didn't have numeric value", + -1); + } + } + return result; + } +} + +/* + *---------------------------------------------------------------------- + * * Math Functions -- * * This page contains the procedures that implement all of the @@ -3402,10 +3465,8 @@ ExprUnaryFunc(interp, eePtr, clientData) Tcl_Obj **stackPtr; /* Cached evaluation stack base pointer. */ register int stackTop; /* Cached top index of evaluation stack. */ register Tcl_Obj *valuePtr; - Tcl_ObjType *tPtr; double d, dResult; - long i; - int length, result; + int result; double (*func) _ANSI_ARGS_((double)) = (double (*)_ANSI_ARGS_((double))) clientData; @@ -3423,27 +3484,16 @@ ExprUnaryFunc(interp, eePtr, clientData) */ valuePtr = POP_OBJECT(); - tPtr = valuePtr->typePtr; + + if (VerifyExprObjType(interp, valuePtr) != TCL_OK) { + result = TCL_ERROR; + goto done; + } - if (tPtr == &tclIntType) { + if (valuePtr->typePtr == &tclIntType) { d = (double) valuePtr->internalRep.longValue; - } else if (tPtr == &tclDoubleType) { - d = valuePtr->internalRep.doubleValue; } else { - char *s = Tcl_GetStringFromObj(valuePtr, &length); - - if (TclLooksLikeInt(s, length)) { - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i); - d = (double) valuePtr->internalRep.longValue; - } else { - result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d); - } - if (result != TCL_OK) { - Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), - "argument to math function didn't have numeric value", -1); - goto done; - } + d = valuePtr->internalRep.doubleValue; } errno = 0; @@ -3483,11 +3533,8 @@ ExprBinaryFunc(interp, eePtr, clientData) Tcl_Obj **stackPtr; /* Cached evaluation stack base pointer. */ register int stackTop; /* Cached top index of evaluation stack. */ register Tcl_Obj *valuePtr, *value2Ptr; - Tcl_ObjType *tPtr; double d1, d2, dResult; - long i; - char *s; - int length, result; + int result; double (*func) _ANSI_ARGS_((double, double)) = (double (*)_ANSI_ARGS_((double, double))) clientData; @@ -3507,44 +3554,22 @@ ExprBinaryFunc(interp, eePtr, clientData) value2Ptr = POP_OBJECT(); valuePtr = POP_OBJECT(); - tPtr = valuePtr->typePtr; - if (tPtr == &tclIntType) { + if ((VerifyExprObjType(interp, valuePtr) != TCL_OK) || + (VerifyExprObjType(interp, value2Ptr) != TCL_OK)) { + result = TCL_ERROR; + goto done; + } + + if (valuePtr->typePtr == &tclIntType) { d1 = (double) valuePtr->internalRep.longValue; - } else if (tPtr == &tclDoubleType) { - d1 = valuePtr->internalRep.doubleValue; } else { - s = Tcl_GetStringFromObj(valuePtr, &length); - if (TclLooksLikeInt(s, length)) { - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i); - d1 = (double) valuePtr->internalRep.longValue; - } else { - result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d1); - } - if (result != TCL_OK) { - badArg: - Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), - "argument to math function didn't have numeric value", -1); - goto done; - } + d1 = valuePtr->internalRep.doubleValue; } - tPtr = value2Ptr->typePtr; - if (tPtr == &tclIntType) { - d2 = value2Ptr->internalRep.longValue; - } else if (tPtr == &tclDoubleType) { - d2 = value2Ptr->internalRep.doubleValue; + if (value2Ptr->typePtr == &tclIntType) { + d2 = (double) value2Ptr->internalRep.longValue; } else { - s = Tcl_GetStringFromObj(value2Ptr, &length); - if (TclLooksLikeInt(s, length)) { - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, value2Ptr, &i); - d2 = (double) value2Ptr->internalRep.longValue; - } else { - result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, value2Ptr, &d2); - } - if (result != TCL_OK) { - goto badArg; - } + d2 = value2Ptr->internalRep.doubleValue; } errno = 0; @@ -3583,10 +3608,9 @@ ExprAbsFunc(interp, eePtr, clientData) Tcl_Obj **stackPtr; /* Cached evaluation stack base pointer. */ register int stackTop; /* Cached top index of evaluation stack. */ register Tcl_Obj *valuePtr; - Tcl_ObjType *tPtr; long i, iResult; double d, dResult; - int length, result; + int result; /* * Set stackPtr and stackTop from eePtr. @@ -3600,34 +3624,17 @@ ExprAbsFunc(interp, eePtr, clientData) */ valuePtr = POP_OBJECT(); - tPtr = valuePtr->typePtr; - - if (tPtr == &tclIntType) { - i = valuePtr->internalRep.longValue; - } else if (tPtr == &tclDoubleType) { - d = valuePtr->internalRep.doubleValue; - } else { - char *s = Tcl_GetStringFromObj(valuePtr, &length); - - if (TclLooksLikeInt(s, length)) { - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i); - } else { - result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d); - } - if (result != TCL_OK) { - Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), - "argument to math function didn't have numeric value", -1); - goto done; - } - tPtr = valuePtr->typePtr; + + if (VerifyExprObjType(interp, valuePtr) != TCL_OK) { + result = TCL_ERROR; + goto done; } /* * Push a Tcl object with the result. */ - - if (tPtr == &tclIntType) { + if (valuePtr->typePtr == &tclIntType) { + i = valuePtr->internalRep.longValue; if (i < 0) { iResult = -i; if (iResult < 0) { @@ -3644,6 +3651,7 @@ ExprAbsFunc(interp, eePtr, clientData) } PUSH_OBJECT(Tcl_NewLongObj(iResult)); } else { + d = valuePtr->internalRep.doubleValue; if (d < 0.0) { dResult = -d; } else { @@ -3656,7 +3664,7 @@ ExprAbsFunc(interp, eePtr, clientData) } PUSH_OBJECT(Tcl_NewDoubleObj(dResult)); } - + /* * Reflect the change to stackTop back in eePtr. */ @@ -3679,8 +3687,7 @@ ExprDoubleFunc(interp, eePtr, clientData) register int stackTop; /* Cached top index of evaluation stack. */ register Tcl_Obj *valuePtr; double dResult; - long i; - int length, result; + int result; /* * Set stackPtr and stackTop from eePtr. @@ -3694,26 +3701,16 @@ ExprDoubleFunc(interp, eePtr, clientData) */ valuePtr = POP_OBJECT(); + + if (VerifyExprObjType(interp, valuePtr) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + if (valuePtr->typePtr == &tclIntType) { dResult = (double) valuePtr->internalRep.longValue; - } else if (valuePtr->typePtr == &tclDoubleType) { - dResult = valuePtr->internalRep.doubleValue; } else { - char *s = Tcl_GetStringFromObj(valuePtr, &length); - - if (TclLooksLikeInt(s, length)) { - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i); - dResult = (double) valuePtr->internalRep.longValue; - } else { - result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, - &dResult); - } - if (result != TCL_OK) { - Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), - "argument to math function didn't have numeric value", -1); - goto done; - } + dResult = valuePtr->internalRep.doubleValue; } /* @@ -3743,11 +3740,9 @@ ExprIntFunc(interp, eePtr, clientData) Tcl_Obj **stackPtr; /* Cached evaluation stack base pointer. */ register int stackTop; /* Cached top index of evaluation stack. */ register Tcl_Obj *valuePtr; - Tcl_ObjType *tPtr; - long i = 0; /* Initialized to avoid compiler warning. */ long iResult; double d; - int length, result; + int result; /* * Set stackPtr and stackTop from eePtr. @@ -3761,36 +3756,16 @@ ExprIntFunc(interp, eePtr, clientData) */ valuePtr = POP_OBJECT(); - tPtr = valuePtr->typePtr; - if (tPtr == &tclIntType) { - i = valuePtr->internalRep.longValue; - } else if (tPtr == &tclDoubleType) { - d = valuePtr->internalRep.doubleValue; - } else { - char *s = Tcl_GetStringFromObj(valuePtr, &length); - - if (TclLooksLikeInt(s, length)) { - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i); - } else { - result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d); - } - if (result != TCL_OK) { - Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), - "argument to math function didn't have numeric value", -1); - goto done; - } - tPtr = valuePtr->typePtr; + if (VerifyExprObjType(interp, valuePtr) != TCL_OK) { + result = TCL_ERROR; + goto done; } - - /* - * Push a Tcl object with the result. - */ - if (tPtr == &tclIntType) { - iResult = i; + if (valuePtr->typePtr == &tclIntType) { + iResult = valuePtr->internalRep.longValue; } else { + d = valuePtr->internalRep.doubleValue; if (d < 0.0) { if (d < (double) (long) LONG_MIN) { tooLarge: @@ -3814,6 +3789,11 @@ ExprIntFunc(interp, eePtr, clientData) } iResult = (long) d; } + + /* + * Push a Tcl object with the result. + */ + PUSH_OBJECT(Tcl_NewLongObj(iResult)); /* @@ -3925,11 +3905,9 @@ ExprRoundFunc(interp, eePtr, clientData) Tcl_Obj **stackPtr; /* Cached evaluation stack base pointer. */ register int stackTop; /* Cached top index of evaluation stack. */ Tcl_Obj *valuePtr; - Tcl_ObjType *tPtr; - long i = 0; /* Initialized to avoid compiler warning. */ long iResult; double d, temp; - int length, result; + int result; /* * Set stackPtr and stackTop from eePtr. @@ -3943,36 +3921,16 @@ ExprRoundFunc(interp, eePtr, clientData) */ valuePtr = POP_OBJECT(); - tPtr = valuePtr->typePtr; - - if (tPtr == &tclIntType) { - i = valuePtr->internalRep.longValue; - } else if (tPtr == &tclDoubleType) { - d = valuePtr->internalRep.doubleValue; - } else { - char *s = Tcl_GetStringFromObj(valuePtr, &length); - - if (TclLooksLikeInt(s, length)) { - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i); - } else { - result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d); - } - if (result != TCL_OK) { - Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), - "argument to math function didn't have numeric value", -1); - goto done; - } - tPtr = valuePtr->typePtr; - } - /* - * Push a Tcl object with the result. - */ + if (VerifyExprObjType(interp, valuePtr) != TCL_OK) { + result = TCL_ERROR; + goto done; + } - if (tPtr == &tclIntType) { - iResult = i; + if (valuePtr->typePtr == &tclIntType) { + iResult = valuePtr->internalRep.longValue; } else { + d = valuePtr->internalRep.doubleValue; if (d < 0.0) { if (d <= (((double) (long) LONG_MIN) - 0.5)) { tooLarge: @@ -3999,6 +3957,11 @@ ExprRoundFunc(interp, eePtr, clientData) } iResult = (long) temp; } + + /* + * Push a Tcl object with the result. + */ + PUSH_OBJECT(Tcl_NewLongObj(iResult)); /* @@ -4023,9 +3986,8 @@ ExprSrandFunc(interp, eePtr, clientData) register int stackTop; /* Cached top index of evaluation stack. */ Interp *iPtr = (Interp *) interp; Tcl_Obj *valuePtr; - Tcl_ObjType *tPtr; long i = 0; /* Initialized to avoid compiler warning. */ - int isDouble, result; + int result; /* * Set stackPtr and stackTop from eePtr. @@ -4039,36 +4001,26 @@ ExprSrandFunc(interp, eePtr, clientData) */ valuePtr = POP_OBJECT(); - tPtr = valuePtr->typePtr; - - if (tPtr == &tclIntType) { - i = valuePtr->internalRep.longValue; - } else { - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i); - if (result != TCL_OK) { - /* - * See if the operand can be interpreted as a double in order to - * improve the error message. - */ - isDouble = 1; - if (valuePtr->typePtr != &tclDoubleType) { - char *s = Tcl_GetString(valuePtr); - double d; - - if (Tcl_GetDouble((Tcl_Interp *) NULL, s, &d) != TCL_OK) { - isDouble = 0; - } - } + if (VerifyExprObjType(interp, valuePtr) != TCL_OK) { + result = TCL_ERROR; + goto badValue; + } - Tcl_ResetResult(interp); - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ", - (isDouble? "floating-point value":"non-numeric string"), - " as argument to srand", (char *) NULL); - Tcl_DecrRefCount(valuePtr); - DECACHE_STACK_INFO(); - return result; - } + if (valuePtr->typePtr == &tclIntType) { + i = valuePtr->internalRep.longValue; + } else { + /* + * At this point, the only other possible type is double + */ + Tcl_ResetResult(interp); + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "can't use floating-point value as argument to srand", + (char *) NULL); + badValue: + Tcl_DecrRefCount(valuePtr); + DECACHE_STACK_INFO(); + return TCL_ERROR; } /* @@ -4132,10 +4084,9 @@ ExprCallMathFunc(interp, eePtr, objc, objv) Tcl_Value args[MAX_MATH_ARGS]; /* Arguments for function call. */ Tcl_Value funcResult; /* Result of function call as Tcl_Value. */ register Tcl_Obj *valuePtr; - Tcl_ObjType *tPtr; long i; double d; - int j, k, length, result; + int j, k, result; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); Tcl_ResetResult(interp); @@ -4174,39 +4125,19 @@ ExprCallMathFunc(interp, eePtr, objc, objv) for (j = 1, k = 0; j < objc; j++, k++) { valuePtr = objv[j]; - tPtr = valuePtr->typePtr; - - if (tPtr == &tclIntType) { - i = valuePtr->internalRep.longValue; - } else if (tPtr == &tclDoubleType) { - d = valuePtr->internalRep.doubleValue; - } else { - /* - * Try to convert to int first then double. - */ - - char *s = Tcl_GetStringFromObj(valuePtr, &length); - - if (TclLooksLikeInt(s, length)) { - result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i); - } else { - result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, - valuePtr, &d); - } - if (result != TCL_OK) { - Tcl_AppendToObj(Tcl_GetObjResult(interp), - "argument to math function didn't have numeric value", -1); - goto done; - } - tPtr = valuePtr->typePtr; + + if (VerifyExprObjType(interp, valuePtr) != TCL_OK) { + result = TCL_ERROR; + goto done; } /* * Copy the object's numeric value to the argument record, * converting it if necessary. */ - - if (tPtr == &tclIntType) { + + if (valuePtr->typePtr == &tclIntType) { + i = valuePtr->internalRep.longValue; if (mathFuncPtr->argTypes[k] == TCL_DOUBLE) { args[k].type = TCL_DOUBLE; args[k].doubleValue = i; @@ -4215,6 +4146,7 @@ ExprCallMathFunc(interp, eePtr, objc, objv) args[k].intValue = i; } } else { + d = valuePtr->internalRep.doubleValue; if (mathFuncPtr->argTypes[k] == TCL_INT) { args[k].type = TCL_INT; args[k].intValue = (long) d; |