Tcl Source Code

Check-in [21866fab39]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:[85ce4bf928] Fix for problems with storing Inf with [binary format R].
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | bug-85ce4bf928
Files: files | file ages | folders
SHA1: 21866fab39b37e301499f59c7b0eed085ebf9752
User & Date: dkf 2015-05-15 22:14:32
References
2015-05-15
22:17 Ticket [85ce4bf928] binary format R Inf stores FLT_MAX status still Open with 4 other changes artifact: 7bd484521b user: dkf
Context
2015-05-15
22:14
[85ce4bf928] Fix for problems with storing Inf with [binary format R]. Leaf check-in: 21866fab39 user: dkf tags: bug-85ce4bf928
14:40
[0f42ff7871] Remove unintentional difference between interpreted and compiled [next]. check-in: 55abfff316 user: dkf tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclBinary.c.

1908
1909
1910
1911
1912
1913
1914


1915
1916
1917
1918
1919
1920
1921
1922
	/*
	 * 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;






>
>
|







1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
	/*
	 * 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) > (FLT_MAX + pow(2, (FLT_MAX_EXP - FLT_MANT_DIG - 1)))) {
	    fvalue = (dvalue >= 0.0) ? INFINITY : -INFINITY;	// c99
	} else if (fabs(dvalue) >= 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;

Changes to tests/binary.test.

504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
...
529
530
531
532
533
534
535












536
537
538
539
540
541
542
....
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
....
1962
1963
1964
1965
1966
1967
1968



































1969
1970
1971
1972
1973
1974
1975
....
2364
2365
2366
2367
2368
2369
2370
















2371
2372
2373
2374
2375
2376
2377
    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 {
................................................................................
    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"}
................................................................................
    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 {
................................................................................
    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
................................................................................
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}]






|


|







 







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







 







|


|







 







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







 







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







504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
...
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
....
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
....
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
....
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
    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 {
................................................................................
    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"}
................................................................................
    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 {
................................................................................
    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
................................................................................
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}]