Handle other invalid sequences, like "1234e" or "-567e+", that could be the start of a valid real number.

2 files changed, 70 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);
diff --git a/tests/link.test b/tests/link.test
index 9ff44db..1e29ac5 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -141,6 +141,27 @@ test link-2.8 {writing C variables from Tcl} -constraints {testlink} -setup {
     set uwide "0O"
     concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
 } -result {0 0.0 0 0 0 0 0 0 0 0 0 0 0.0 0 | 0x 0b 0 0 0O 0X 0B 0O 0x 0b 0o 0X 0B 0O}
+test link-2.8 {writing C variables from Tcl} -constraints {testlink} -setup {
+    testlink delete
+} -body {
+    testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+    set int 0
+    set real 5000e
+    set bool 0
+    set string 0
+    set wide 0
+    set char 0
+    set uchar 0
+    set short 0
+    set ushort 0
+    set uint 0
+    set long 0
+    set ulong 0
+    set float -6000e+
+    set uwide 0
+    concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
+} -result {0 5000.0 0 0 0 0 0 0 0 0 0 0 -6000.0 0 | 0 5000e 0 0 0 0 0 0 0 0 0 0 -6000e+ 0}
 
 test link-3.1 {read-only variables} {testlink} {
     testlink delete