summaryrefslogtreecommitdiffstats
path: root/generic/tclLink.c
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2016-12-23 11:59:05 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2016-12-23 11:59:05 (GMT)
commitdbd049268f498307121d7fb7a27dafe23d856637 (patch)
treeb85dcf981d04044e55d96f77bb2fe8c4af772fe1 /generic/tclLink.c
parent87a0d0b706167c246ba2a4e61fc7f87b69c3b7a2 (diff)
downloadtcl-dbd049268f498307121d7fb7a27dafe23d856637.zip
tcl-dbd049268f498307121d7fb7a27dafe23d856637.tar.gz
tcl-dbd049268f498307121d7fb7a27dafe23d856637.tar.bz2
Handle other invalid sequences, like "1234e" or "-567e+", that could be the start of a valid real number.
Diffstat (limited to 'generic/tclLink.c')
-rw-r--r--generic/tclLink.c54
1 files changed, 49 insertions, 5 deletions
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 56f8a5c..a80ec8a 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -677,6 +677,50 @@ ObjValue(
return resultObj;
}
}
+
+static int SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+
+static Tcl_ObjType invalidRealType = {
+ "invalidReal", /* name */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetInvalidRealFromAny /* setFromAnyProc */
+};
+
+static int
+SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
+ int length;
+ const char *str;
+ const char *endPtr;
+
+ str = TclGetStringFromObj(objPtr, &length);
+ if ((length == 1) && (str[0] == '.')){
+ objPtr->typePtr = &invalidRealType;
+ objPtr->internalRep.doubleValue = 0.0;
+ return TCL_OK;
+ }
+ if (TclParseNumber(NULL, objPtr, NULL, str, length, &endPtr,
+ TCL_PARSE_DECIMAL_ONLY|TCL_PARSE_INTEGER_ONLY) == TCL_OK) {
+ /* If number is followed by [eE][+-]?, then it is an invalid
+ * double, but it could be the start of a valid double. */
+ if (*endPtr == 'e' || *endPtr == 'E') {
+ ++endPtr;
+ if (*endPtr == '+' || *endPtr == '-') ++endPtr;
+ if (*endPtr == 0) {
+ double doubleValue = 0.0;
+ Tcl_GetDoubleFromObj(NULL, objPtr, &doubleValue);
+ if (objPtr->typePtr->freeIntRepProc) objPtr->typePtr->freeIntRepProc(objPtr);
+ objPtr->typePtr = &invalidRealType;
+ objPtr->internalRep.doubleValue = doubleValue;
+ return TCL_OK;
+ }
+ }
+ }
+ return TCL_ERROR;
+}
+
+
/*
* This function checks for integer representations, which are valid
* when linking with C variables, but which are invalid in other
@@ -704,17 +748,17 @@ GetInvalidIntFromObj(Tcl_Obj *objPtr,
* This function checks for double representations, which are valid
* when linking with C variables, but which are invalid in other
* contexts in Tcl. Handled are ".", "+", "-", "0x", "0b" and "0o"
- * (upper- and lowercase). See bug [39f6304c2e].
+ * (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e].
*/
int
GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
double *doublePtr)
{
- int length, intValue, result;
- const char *str = TclGetStringFromObj(objPtr, &length);
+ int intValue, result;
- if ((length == 1) && (str[0] == '.')){
- *doublePtr = 0.0;
+ if ((objPtr->typePtr == &invalidRealType) ||
+ (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK)) {
+ *doublePtr = objPtr->internalRep.doubleValue;
return TCL_OK;
}
result = GetInvalidIntFromObj(objPtr, &intValue);