Check-in [48706a2425]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fix for [85ce4bf928]: binary format R Inf] stores FLT_MAX
Timelines: family | ancestors | descendants | both | core-8-branch
Files: files | file ages | folders
SHA3-256: 48706a24257346956bbd1932c61c149f0bcd8e0994d66259a9e8c4f92b4d8353
User & Date: jan.nijtmans 2022-11-05 10:08:36.404
References
2022-11-10
13:56 Closed ticket [85ce4bf928]: binary format R Inf stores FLT_MAX plus 7 other changes artifact: 0d0318ebc8 user: jan.nijtmans
Context
2022-11-05
10:28
Add lreplace4 BCC instruction. Rewrite linsert, lreplace to use it. check-in: 7541ec8fb1 user: apnadkarni tags: core-8-branch
10:08
Fix for [85ce4bf928]: binary format R Inf] stores FLT_MAX check-in: 48706a2425 user: jan.nijtmans tags: core-8-branch
2022-11-02
15:00
Proposed fix for [85ce4bf928]: Fix for problems with storing Inf with [binary format R] Closed-Leaf check-in: 20959e0da2 user: jan.nijtmans tags: bug-85ce4bf928
10:00
If CFLAGS contains -DTCL_NO_DEPRECATED, remove TclInitCompiledLocals. More code cleanup (backported ... check-in: 722273ad42 user: jan.nijtmans tags: core-8-branch
Changes
Unified Diff Ignore Whitespace Patch
Changes to generic/tclBinary.c.
2190
2191
2192
2193
2194
2195
2196



2197

2198
2199
2200
2201
2202
2203
2204
	/*
	 * Because some compilers will generate floating point exceptions on
	 * an overflow cast (e.g. Borland), we restrict the values to the
	 * valid range for float.
	 */

	if (fabs(dvalue) > (double) FLT_MAX) {



	    fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;

	} else {
	    fvalue = (float) dvalue;
	}
	CopyNumber(&fvalue, *cursorPtr, sizeof(float), type);
	*cursorPtr += sizeof(float);
	return TCL_OK;








>
>
>

>







2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
	/*
	 * Because some compilers will generate floating point exceptions on
	 * an overflow cast (e.g. Borland), we restrict the values to the
	 * 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 {
	    fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
	    }
	} else {
	    fvalue = (float) dvalue;
	}
	CopyNumber(&fvalue, *cursorPtr, sizeof(float), type);
	*cursorPtr += sizeof(float);
	return TCL_OK;

Changes to tests/binary.test.
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
    binary format f2 {1.6 3.4 5.6}
} \x3F\xCC\xCC\xCD\x40\x59\x99\x9A
test binary-13.11 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format f2 {1.6 3.4 5.6}
} \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
test binary-13.13 {Tcl_BinaryObjCmd: float overflow} littleEndian {
    binary format f -3.402825e+38
} \xFF\xFF\x7F\xFF
test binary-13.14 {Tcl_BinaryObjCmd: float underflow} bigEndian {
    binary format f -3.402825e-100
} \x80\x00\x00\x00
test binary-13.15 {Tcl_BinaryObjCmd: float underflow} littleEndian {
    binary format f -3.402825e-100
} \x00\x00\x00\x80
test binary-13.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {







|


|







508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
    binary format f2 {1.6 3.4 5.6}
} \x3F\xCC\xCC\xCD\x40\x59\x99\x9A
test binary-13.11 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format f2 {1.6 3.4 5.6}
} \xCD\xCC\xCC\x3F\x9A\x99\x59\x40
test binary-13.12 {Tcl_BinaryObjCmd: float overflow} bigEndian {
    binary format f -3.402825e+38
} \xFF\x80\x00\x00
test binary-13.13 {Tcl_BinaryObjCmd: float overflow} littleEndian {
    binary format f -3.402825e+38
} \x00\x00\x80\xFF
test binary-13.14 {Tcl_BinaryObjCmd: float underflow} bigEndian {
    binary format f -3.402825e-100
} \x80\x00\x00\x00
test binary-13.15 {Tcl_BinaryObjCmd: float underflow} littleEndian {
    binary format f -3.402825e-100
} \x00\x00\x00\x80
test binary-13.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
533
534
535
536
537
538
539












540
541
542
543
544
545
546
    set a {1.6 3.4}
    binary format f1 $a
} \x3F\xCC\xCC\xCD
test binary-13.19 {Tcl_BinaryObjCmd: format} littleEndian {
    set a {1.6 3.4}
    binary format f1 $a
} \xCD\xCC\xCC\x3F













test binary-14.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format d
} -result {not enough arguments for all format specifiers}
test binary-14.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format d blat
} -result {expected floating-point number but got "blat"}







>
>
>
>
>
>
>
>
>
>
>
>







533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
    set a {1.6 3.4}
    binary format f1 $a
} \x3F\xCC\xCC\xCD
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
} -result {not enough arguments for all format specifiers}
test binary-14.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format d blat
} -result {expected floating-point number but got "blat"}
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
    binary format R2 {1.6 3.4 5.6}
} \x3F\xCC\xCC\xCD\x40\x59\x99\x9A
test binary-53.11 {Tcl_BinaryObjCmd: format} {} {
    binary format r2 {1.6 3.4 5.6}
} \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
test binary-53.13 {Tcl_BinaryObjCmd: float overflow} {} {
    binary format r -3.402825e+38
} \xFF\xFF\x7F\xFF
test binary-53.14 {Tcl_BinaryObjCmd: float underflow} {} {
    binary format R -3.402825e-100
} \x80\x00\x00\x00
test binary-53.15 {Tcl_BinaryObjCmd: float underflow} {} {
    binary format r -3.402825e-100
} \x00\x00\x00\x80
test binary-53.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {







|


|







1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
    binary format R2 {1.6 3.4 5.6}
} \x3F\xCC\xCC\xCD\x40\x59\x99\x9A
test binary-53.11 {Tcl_BinaryObjCmd: format} {} {
    binary format r2 {1.6 3.4 5.6}
} \xCD\xCC\xCC\x3F\x9A\x99\x59\x40
test binary-53.12 {Tcl_BinaryObjCmd: float overflow} {} {
    binary format R -3.402825e+38
} \xFF\x80\x00\x00
test binary-53.13 {Tcl_BinaryObjCmd: float overflow} {} {
    binary format r -3.402825e+38
} \x00\x00\x80\xFF
test binary-53.14 {Tcl_BinaryObjCmd: float underflow} {} {
    binary format R -3.402825e-100
} \x80\x00\x00\x00
test binary-53.15 {Tcl_BinaryObjCmd: float underflow} {} {
    binary format r -3.402825e-100
} \x00\x00\x00\x80
test binary-53.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
1996
1997
1998
1999
2000
2001
2002

































2003
2004
2005
2006
2007
2008
2009
    set a {1.6 3.4}
    binary format R1 $a
} \x3F\xCC\xCC\xCD
test binary-53.19 {Tcl_BinaryObjCmd: format} {} {
    set a {1.6 3.4}
    binary format r1 $a
} \xCD\xCC\xCC\x3F


































# scan t (s)
test binary-54.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc t
} -result {not enough arguments for all format specifiers}
test binary-54.2 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
    set a {1.6 3.4}
    binary format R1 $a
} \x3F\xCC\xCC\xCD
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 {
    binary scan abc t
} -result {not enough arguments for all format specifiers}
test binary-54.2 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
















2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
    format 0x%016lx $w
} 0x7ff0000000000000
test binary-62.4 {infinity} ieeeFloatingPoint {
    binary scan [binary format q -Infinity] w w
    format 0x%016lx $w
} 0xfff0000000000000
test binary-62.5 {infinity} ieeeFloatingPoint {
    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
















    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}]
} 0x7ff0000000000000
test binary-63.2 {NaN} ieeeFloatingPoint {
    binary scan [binary format q -NaN] w w
    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}]
} 0x7ff3123456789abc
test binary-63.4 {NaN} ieeeFloatingPoint {
    binary scan [binary format q {NaN( 3123456789aBc)}] w w
    format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
} 0x7ff3123456789abc

# Make sure TclParseNumber() rejects invalid nan-hex formats [Bug 3402540]
test binary-63.5 {NaN} -constraints ieeeFloatingPoint -body {
    binary format q Nan(
} -returnCodes error -match glob -result {expected floating-point number*}
test binary-63.6 {NaN} -constraints ieeeFloatingPoint -body {







|



|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







|



|



|



|







2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
    format 0x%016lx $w
} 0x7ff0000000000000
test binary-62.4 {infinity} ieeeFloatingPoint {
    binary scan [binary format q -Infinity] w w
    format 0x%016lx $w
} 0xfff0000000000000
test binary-62.5 {infinity} ieeeFloatingPoint {
    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
    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}]
} 0x7ff0000000000000
test binary-63.2 {NaN} ieeeFloatingPoint {
    binary scan [binary format q -NaN] w w
    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}]
} 0x7ff3123456789abc
test binary-63.4 {NaN} ieeeFloatingPoint {
    binary scan [binary format q {NaN( 3123456789aBc)}] w w
    format 0x%016lx [expr {$w & 0xFFF3FFFFFFFFFFFF}]
} 0x7ff3123456789abc

# Make sure TclParseNumber() rejects invalid nan-hex formats [Bug 3402540]
test binary-63.5 {NaN} -constraints ieeeFloatingPoint -body {
    binary format q Nan(
} -returnCodes error -match glob -result {expected floating-point number*}
test binary-63.6 {NaN} -constraints ieeeFloatingPoint -body {