summaryrefslogtreecommitdiffstats
path: root/generic/tclExecute.c
diff options
context:
space:
mode:
authorhobbs <hobbs>1999-12-04 06:15:40 (GMT)
committerhobbs <hobbs>1999-12-04 06:15:40 (GMT)
commit78a6d2f842a7ff7465cd0397481a93c78375096f (patch)
treec153fe1950b58db095afef4ac9ea58a5e73ebb2a /generic/tclExecute.c
parent5239dbb3790e4d48cee4dad3455a529b18b6c30b (diff)
downloadtcl-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.c388
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;