Proposed fix for [85ce4bf928]: Fix for problems with storing Inf with…

… [binary format R]
sebres · Nov 2, 2022 · 09a2dbe · 09a2dbe
2 parents b698fa6 + 54a2c47
commit 09a2dbe
Show file tree

Hide file tree

Showing 2 changed files with 74 additions and 11 deletions.
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
@@ -2193,7 +2193,9 @@ FormatNumber(
 	 * valid range for float.
 	 */
 
-	if (fabs(dvalue) > (double) FLT_MAX) {
+	if (fabs(dvalue) > (FLT_MAX + pow(2, (FLT_MAX_EXP - FLT_MANT_DIG - 1)))) {
+	    fvalue = (dvalue >= 0.0) ? INFINITY : -INFINITY;	// c99
+	} else if (fabs(dvalue) > (double) FLT_MAX) {
 	    fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
 	} else {
 	    fvalue = (float) dvalue;

diff --git a/tests/binary.test b/tests/binary.test
@@ -512,10 +512,10 @@ test binary-13.11 {Tcl_BinaryObjCmd: format} littleEndian {
 } \xCD\xCC\xCC\x3F\x9A\x99\x59\x40
 test binary-13.12 {Tcl_BinaryObjCmd: float overflow} bigEndian {
     binary format f -3.402825e+38
-} \xFF\x7F\xFF\xFF
+} \xFF\x80\x00\x00
 test binary-13.13 {Tcl_BinaryObjCmd: float overflow} littleEndian {
     binary format f -3.402825e+38
-} \xFF\xFF\x7F\xFF
+} \x00\x00\x80\xFF
 test binary-13.14 {Tcl_BinaryObjCmd: float underflow} bigEndian {
     binary format f -3.402825e-100
 } \x80\x00\x00\x00
@@ -537,6 +537,18 @@ test binary-13.19 {Tcl_BinaryObjCmd: format} littleEndian {
     set a {1.6 3.4}
     binary format f1 $a
 } \xCD\xCC\xCC\x3F
+test binary-13.20 {Tcl_BinaryObjCmd: format float Inf} bigEndian {
+    binary format f Inf
+} \x7F\x80\x00\x00
+test binary-13.21 {Tcl_BinaryObjCmd: format float Inf} littleEndian {
+    binary format f Inf
+} \x00\x00\x80\x7F
+test binary-13.22 {Tcl_BinaryObjCmd: format float -Inf} bigEndian {
+    binary format f -Inf
+} \xFF\x80\x00\x00
+test binary-13.23 {Tcl_BinaryObjCmd: format float -Inf} littleEndian {
+    binary format f -Inf
+} \x00\x00\x80\xFF
 
 test binary-14.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
     binary format d
@@ -1975,10 +1987,10 @@ test binary-53.11 {Tcl_BinaryObjCmd: format} {} {
 } \xCD\xCC\xCC\x3F\x9A\x99\x59\x40
 test binary-53.12 {Tcl_BinaryObjCmd: float overflow} {} {
     binary format R -3.402825e+38
-} \xFF\x7F\xFF\xFF
+} \xFF\x80\x00\x00
 test binary-53.13 {Tcl_BinaryObjCmd: float overflow} {} {
     binary format r -3.402825e+38
-} \xFF\xFF\x7F\xFF
+} \x00\x00\x80\xFF
 test binary-53.14 {Tcl_BinaryObjCmd: float underflow} {} {
     binary format R -3.402825e-100
 } \x80\x00\x00\x00
@@ -2000,6 +2012,39 @@ test binary-53.19 {Tcl_BinaryObjCmd: format} {} {
     set a {1.6 3.4}
     binary format r1 $a
 } \xCD\xCC\xCC\x3F
+test binary-53.20 {Tcl_BinaryObjCmd: float Inf} {} {
+    binary format R Inf
+} \x7f\x80\x00\x00
+test binary-53.21 {Tcl_BinaryObjCmd: float Inf} {} {
+    binary format r Inf
+} \x00\x00\x80\x7f
+test binary-53.22 {Binary float Inf round trip} -body {
+    binary scan [binary format R Inf] R inf
+    binary scan [binary format R -Inf] R inf_
+    list $inf $inf_
+} -result {Inf -Inf}
+test binary-53.23 {Binary float round to FLT_MAX} -body {
+    binary scan [binary format H* 7f7fffff] R fltmax
+    binary scan [binary format H* 47effffff0000000] Q round_to_fltmax
+    binary scan [binary format R $round_to_fltmax] R fltmax1
+    expr {$fltmax eq $fltmax1}
+} -result 1
+test binary-53.24 {Binary float round to -FLT_MAX} -body {
+    binary scan [binary format H* ff7fffff] R fltmax
+    binary scan [binary format H* c7effffff0000000] Q round_to_fltmax
+    binary scan [binary format R $round_to_fltmax] R fltmax1
+    expr {$fltmax eq $fltmax1}
+} -result 1
+test binary-53.25 {Binary float round to Inf} -body {
+    binary scan [binary format H* 47effffff0000001] Q round_to_inf
+    binary scan [binary format R $round_to_inf] R inf1
+    expr {$inf1 eq Inf}
+} -result 1
+test binary-53.26 {Binary float round to -Inf} -body {
+    binary scan [binary format H* c7effffff0000001] Q round_to_inf
+    binary scan [binary format R $round_to_inf] R inf1
+    expr {$inf1 eq -Inf}
+} -result 1
 
 # scan t (s)
 test binary-54.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
@@ -2396,31 +2441,47 @@ test binary-62.4 {infinity} ieeeFloatingPoint {
     format 0x%016lx $w
 } 0xfff0000000000000
 test binary-62.5 {infinity} ieeeFloatingPoint {
-    binary scan [binary format w 0x7ff0000000000000] q d
+    binary scan [binary format w 0x7FF0000000000000] q d
     set d
 } Inf
 test binary-62.6 {infinity} ieeeFloatingPoint {
-    binary scan [binary format w 0xfff0000000000000] q d
+    binary scan [binary format w 0xFFF0000000000000] q d
+    set d
+} -Inf
+test binary-62.7 {infinity} ieeeFloatingPoint {
+    binary scan [binary format r Inf] iu i
+    format 0x%08x $i
+} 0x7f800000
+test binary-62.8 {infinity} ieeeFloatingPoint {
+    binary scan [binary format r -Inf] iu i
+    format 0x%08x $i
+} 0xff800000
+test binary-62.9 {infinity} ieeeFloatingPoint {
+    binary scan [binary format i 0x7F800000] r d
+    set d
+} Inf
+test binary-62.10 {infinity} ieeeFloatingPoint {
+    binary scan [binary format i 0xFF800000] r d
     set d
 } -Inf
 
 # scan/format Not-a-Number
 
 test binary-63.1 {NaN} ieeeFloatingPoint {
     binary scan [binary format q NaN] w w
-    format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
+    format 0x%016lx [expr {$w & 0xFFF3FFFFFFFFFFFF}]
 } 0x7ff0000000000000
 test binary-63.2 {NaN} ieeeFloatingPoint {
     binary scan [binary format q -NaN] w w
-    format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
+    format 0x%016lx [expr {$w & 0xFFF3FFFFFFFFFFFF}]
 } 0xfff0000000000000
 test binary-63.3 {NaN} ieeeFloatingPoint {
     binary scan [binary format q NaN(3123456789aBc)] w w
-    format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
+    format 0x%016lx [expr {$w & 0xFFF3FFFFFFFFFFFF}]
 } 0x7ff3123456789abc
 test binary-63.4 {NaN} ieeeFloatingPoint {
     binary scan [binary format q {NaN( 3123456789aBc)}] w w
-    format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
+    format 0x%016lx [expr {$w & 0xFFF3FFFFFFFFFFFF}]
 } 0x7ff3123456789abc
 
 # Make sure TclParseNumber() rejects invalid nan-hex formats [Bug 3402540]