From 075a14cd434896a7f50d0e50b40ab7068db6a10c Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Mon, 5 May 2025 06:21:52 +0000
Subject: [42d14c495a] Add source code comment and test case provided by
 Christian Werner (thanks)

---
 generic/tclStrToD.c |  7 +++++++
 tests/scan.test     | 52 +++++++++++++++++++++++++++++++++++++++++++++-------
 2 files changed, 52 insertions(+), 7 deletions(-)

diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index f530257..5203639 100644
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -1805,6 +1805,13 @@ MakeHighPrecisionDouble(
      * for overflow. Convert back to a double, and test for underflow.
      */
 
+    /*
+     * TCL bug ca62367d61: the following two if-conditions handle the case,
+     * if the mantissa is to long to be represented.
+     * Very high numbers are returned, if this is not handled
+     */
+
+
     if (exponent < -511) {
 	mp_init_copy(&bntmp, significand);
 	shift = -exponent - 511;
diff --git a/tests/scan.test b/tests/scan.test
index 77ae1f5..606d812 100644
--- a/tests/scan.test
+++ b/tests/scan.test
@@ -869,13 +869,51 @@ test scan-14.2 {negative infinity} {
     return $d
 } -Inf
 
-test scan-15.1 {scan %g overflow for small numbers and big mantissa bug 42d14c495a (passes without fix)} {
-    scan "1.[string repeat 1 190]e-321" %g
-} 1.11e-321
-
-test scan-15.2 {scan %g overflow for small numbers and big mantissa bug 42d14c495a (requires fix)} {
-    scan "1.[string repeat 1 191]e-321" %g
-} 1.11e-321
+test scan-15.1 {scan %g overflow for small numbers and big mantissa bug 42d14c495a} {
+    set result [list]
+    # xfail: n<num> = not expected at all, x<num> expected when unfixed
+    foreach {exp numdig ret xfail} {
+	-321  190 1.111647703142804724397279783953498087821e-321 n0
+	-321  191 1.111647703142804724397279783953498087821e-321 x1
+	-321  300 1.111647703142804724397279783953498087821e-321 x2
+	-321 1600 1.111647703142804724397279783953498087821e-321 x3
+	-400  110 0 n4
+	-400  111 0 n5
+	-400  300 0 n6
+	-221  290 1.111111111111110993454921768172890541494e-221 n7
+	-221  291 1.111111111111110993454921768172890541494e-221 x8
+	-221  400 1.111111111111110993454921768172890541494e-221 x9
+	-221 1600 1.111111111111110993454921768172890541494e-221 x10
+	-121  390 1.111111111111111182884141698869046969295e-121 n11
+	-121  391 1.111111111111111182884141698869046969295e-121 x12
+	-121  500 1.111111111111111182884141698869046969295e-121 x13
+	-121 1600 1.111111111111111182884141698869046969295e-121 x14
+	 308  202 1.111111111111111167662077577927612945036e+308 n15
+	 308  203 1.111111111111111167662077577927612945036e+308 n16
+	 308  300 1.111111111111111167662077577927612945036e+308 n17
+	 308 1600 1.111111111111111167662077577927612945036e+308 x18
+	 400  110 inf n19
+	 400  111 inf n20
+	 400  300 inf n21
+	 221  291 1.111111111111111207481621395250718679869e+221 n22
+	 221  292 1.111111111111111207481621395250718679869e+221 n23
+	 221  400 1.111111111111111207481621395250718679869e+221 n24
+         221 1600 1.111111111111111207481621395250718679869e+221 x25
+	 121  391 1.11111111111111112711771954138363761759e+121 n26
+	 121  392 1.11111111111111112711771954138363761759e+121 n27
+	 121  500 1.11111111111111112711771954138363761759e+121 n28
+	 121 1600 1.11111111111111112711771954138363761759e+121 x29
+    } {
+	set s 1.[string repeat 1 $numdig]e$exp
+	set d "no_scan"
+	scan $s %g d
+	set r [format %.40g $d]
+	if {$r ne $ret} {
+	    lappend result $xfail=[format %.40g $d]
+	}
+    }
+    set result
+} {}
 
 # TODO - also need to scan NaN's
 
-- 
cgit v0.12