Tcl Source Code

Check-in [5598fa3c00]
Login

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

Overview
Comment:Fix compilation on 32-bit platforms, and fix unit-tests in this environment
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-514
Files: files | file ages | folders
SHA3-256:5598fa3c00c1820d41d67ae599fa4db5d57edb0086a83f3bda789a8100b4c721
User & Date: jan.nijtmans 2018-08-29 19:30:37
Context
2018-08-30
21:28
Merge 8.7, and improve TIP implementation (using utility function in more places) check-in: 47b67cd37d user: jan.nijtmans tags: tip-514
2018-08-29
19:30
Fix compilation on 32-bit platforms, and fix unit-tests in this environment check-in: 5598fa3c00 user: jan.nijtmans tags: tip-514
2018-08-28
22:28
Now, restore wide(), but make int() the same as entier(). Add new utility function. check-in: d6c1d88425 user: jan.nijtmans tags: tip-514
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclObj.c.

2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
	     * the internal rep.
	     */

	    Tcl_WideInt w = objPtr->internalRep.wideValue;

	    if (
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
		    w <= (Tcl_WideInt)(ULONG_MAX)) {
#else
		    w <= (Tcl_WideInt)(LONG_MAX)) {
#endif
		    && w >= (Tcl_WideInt)(LONG_MIN)
		*longPtr = Tcl_WideAsLong(w);
		return TCL_OK;
	    }
	    goto tooLarge;
	}
#endif
	if (objPtr->typePtr == &tclDoubleType) {







|

|

|







2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
	     * the internal rep.
	     */

	    Tcl_WideInt w = objPtr->internalRep.wideValue;

	    if (
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
		    (w <= (Tcl_WideInt)(ULONG_MAX))
#else
		    (w <= (Tcl_WideInt)(LONG_MAX))
#endif
		    && (w >= (Tcl_WideInt)(LONG_MIN))) {
		*longPtr = Tcl_WideAsLong(w);
		return TCL_OK;
	    }
	    goto tooLarge;
	}
#endif
	if (objPtr->typePtr == &tclDoubleType) {

Changes to tests/compExpr-old.test.

328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350


test compExpr-old-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
test compExpr-old-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
test compExpr-old-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
test compExpr-old-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8

# The following test is different for 32-bit versus 64-bit
# architectures because LONG_MIN is different

test compExpr-old-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit {
    expr {int(1<<63)}
} 9223372036854775808
test compExpr-old-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit {
    expr {int(1<<31)}
} -2147483648

test compExpr-old-9.6 {CompileRelationalExpr: error in shift expr} -body {
    expr x>>3
} -returnCodes error -match glob -result *
test compExpr-old-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
test compExpr-old-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
test compExpr-old-9.9 {CompileRelationalExpr: error compiling relational arm} -body {







|
|

|


<
<
<







328
329
330
331
332
333
334
335
336
337
338
339
340



341
342
343
344
345
346
347


test compExpr-old-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
test compExpr-old-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
test compExpr-old-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
test compExpr-old-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8

# The following test is no longer different for 32-bit versus 64-bit
# architectures

test compExpr-old-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {
    expr {int(1<<63)}
} 9223372036854775808




test compExpr-old-9.6 {CompileRelationalExpr: error in shift expr} -body {
    expr x>>3
} -returnCodes error -match glob -result *
test compExpr-old-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
test compExpr-old-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
test compExpr-old-9.9 {CompileRelationalExpr: error compiling relational arm} -body {

Changes to tests/expr.test.

413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
....
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
....
5805
5806
5807
5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
....
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
....
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
5941
5942
5943
....
6716
6717
6718
6719
6720
6721
6722
6723
6724
6725
6726
6727
6728
6729
6730
6731
....
6742
6743
6744
6745
6746
6747
6748
6749
6750
6751
6752
6753
6754
6755
6756
6757
    expr {1ea}
} -returnCodes error -match glob -result *

test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
test expr-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
test expr-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
test expr-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit {
    expr {int(1<<63)}
} 9223372036854775808
test expr-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit {
    expr {int(1<<31)}
} -2147483648
test expr-9.6 {CompileRelationalExpr: error in shift expr} -body {
    expr x>>3
} -returnCodes error -match glob -result *
test expr-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
test expr-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
test expr-9.9 {CompileRelationalExpr: error compiling relational arm} -body {
    expr 2***3>6
................................................................................


# Some compilers get this wrong; ensure that we work around it correctly
test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0
test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0
test expr-24.3 {expr edge cases; shifting} {expr wide(5)>>32} 0
test expr-24.4 {expr edge cases; shifting} {expr wide(5)>>63} 0
test expr-24.5 {expr edge cases; shifting} longIs32bit {expr int(5<<32)} 0
test expr-24.6 {expr edge cases; shifting} longIs32bit {expr int(5<<63)} 0
test expr-24.7 {expr edge cases; shifting} {expr wide(5)<<32} 21474836480
test expr-24.8 {expr edge cases; shifting} {expr wide(10<<63)} 0
test expr-24.9 {expr edge cases; shifting} {expr 5>>32} 0

test expr-24.10 {INST_LSHIFT: Bug 1567222} {expr 500000000000000<<28} 134217728000000000000000

# List membership tests
................................................................................
test expr-32.8 {bignum regression} {
    expr {0%-(1<<63)}
} 0
test expr-32.9 {bignum regression} {
    expr {0%-(1+(1<<63))}
} 0

test expr-33.1 {parse largest long value} longIs32bit {
    set max_long_str 2147483647
    set max_long_hex "0x7FFFFFFF "

    # Convert to integer (long, not wide) internal rep
    set max_long 2147483647
    string is integer $max_long

    list \
        [expr {" $max_long_str "}] \
        [expr {$max_long_str + 0}] \
        [expr {$max_long + 0}] \
        [expr {2147483647 + 0}] \
        [expr {$max_long == $max_long_hex}] \
        [expr {int(2147483647 + 1) < 0}] \

} {2147483647 2147483647 2147483647 2147483647 1 1}
test expr-33.2 {parse smallest long value} longIs32bit {
    set min_long_str -2147483648
    set min_long_hex "-0x80000000 "

    set min_long -2147483648
................................................................................
    # when it should be parsed as a long type.
    list \
        [expr {" $min_long_str "}] \
        [expr {$min_long_str + 0}] \
        [expr {$min_long + 0}] \
        [expr {-2147483648 + 0}] \
        [expr {$min_long == $min_long_hex}] \
        [expr {int(-2147483648 - 1) == 0x7FFFFFFF}] \

} {-2147483648 -2147483648 -2147483648 -2147483648 1 1}
test expr-33.3 {parse largest wide value} wideIs64bit {
    set max_wide_str 9223372036854775807
    set max_wide_hex "0x7FFFFFFFFFFFFFFF "

    # Convert to wide integer
................................................................................
} {-2}
test expr-34.11 {expr edge cases} {
    expr {$min / -2}
} {1073741824}
test expr-34.12 {expr edge cases} {
    expr {$min % -2}
} {0}
test expr-34.13 {expr edge cases} longIs32bit {
    expr {int($min / -1)}
} {-2147483648}
test expr-34.14 {expr edge cases} {
    expr {$min % -1}
} {0}
test expr-34.15 {expr edge cases} longIs32bit {
    expr {int($min * -1)}
} $min
test expr-34.16 {expr edge cases} longIs32bit {
    expr {int(-$min)}
} $min
test expr-34.17 {expr edge cases} {
    expr {$min / 1}
} $min
test expr-34.18 {expr edge cases} {
    expr {$min % 1}
} {0}
................................................................................
	list [catch {testexprlongobj 0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-39.8 {Tcl_ExprLongObj handles overflows} testexprlongobj {
    testexprlongobj -0x80000000
} {This is a result: -2147483648}
test expr-39.9 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
    testexprlongobj -0xffffffff
} {This is a result: 1}
test expr-39.10 {Tcl_ExprLongObj handles overflows} \
    -constraints {testexprlongobj longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlongobj -0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}
................................................................................
	list [catch {testexprlongobj 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-39.14 {Tcl_ExprLongObj handles overflows} testexprlongobj {
    testexprlongobj -2147483648.
} {This is a result: -2147483648}
test expr-39.15 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
    testexprlongobj -4294967295.
} {This is a result: 1}
test expr-39.16 {Tcl_ExprLongObj handles overflows} \
    -constraints {testexprlongobj longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlongobj 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}







|


<
<
<







 







|
|







 







|













|







 







|







 







|

|



|
|

|
|







 







|
|







 







|
|







413
414
415
416
417
418
419
420
421
422



423
424
425
426
427
428
429
....
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
....
5802
5803
5804
5805
5806
5807
5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
....
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
....
5916
5917
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
....
6713
6714
6715
6716
6717
6718
6719
6720
6721
6722
6723
6724
6725
6726
6727
6728
....
6739
6740
6741
6742
6743
6744
6745
6746
6747
6748
6749
6750
6751
6752
6753
6754
    expr {1ea}
} -returnCodes error -match glob -result *

test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
test expr-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
test expr-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {
    expr {int(1<<63)}
} 9223372036854775808



test expr-9.6 {CompileRelationalExpr: error in shift expr} -body {
    expr x>>3
} -returnCodes error -match glob -result *
test expr-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
test expr-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
test expr-9.9 {CompileRelationalExpr: error compiling relational arm} -body {
    expr 2***3>6
................................................................................


# Some compilers get this wrong; ensure that we work around it correctly
test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0
test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0
test expr-24.3 {expr edge cases; shifting} {expr wide(5)>>32} 0
test expr-24.4 {expr edge cases; shifting} {expr wide(5)>>63} 0
test expr-24.5 {expr edge cases; shifting} {expr int(5<<32)} 21474836480
test expr-24.6 {expr edge cases; shifting} {expr int(5<<63)} 46116860184273879040
test expr-24.7 {expr edge cases; shifting} {expr wide(5)<<32} 21474836480
test expr-24.8 {expr edge cases; shifting} {expr wide(10<<63)} 0
test expr-24.9 {expr edge cases; shifting} {expr 5>>32} 0

test expr-24.10 {INST_LSHIFT: Bug 1567222} {expr 500000000000000<<28} 134217728000000000000000

# List membership tests
................................................................................
test expr-32.8 {bignum regression} {
    expr {0%-(1<<63)}
} 0
test expr-32.9 {bignum regression} {
    expr {0%-(1+(1<<63))}
} 0

test expr-33.1 {parse largest long value} {
    set max_long_str 2147483647
    set max_long_hex "0x7FFFFFFF "

    # Convert to integer (long, not wide) internal rep
    set max_long 2147483647
    string is integer $max_long

    list \
        [expr {" $max_long_str "}] \
        [expr {$max_long_str + 0}] \
        [expr {$max_long + 0}] \
        [expr {2147483647 + 0}] \
        [expr {$max_long == $max_long_hex}] \
        [expr {int(2147483647 + 1) > 0}] \

} {2147483647 2147483647 2147483647 2147483647 1 1}
test expr-33.2 {parse smallest long value} longIs32bit {
    set min_long_str -2147483648
    set min_long_hex "-0x80000000 "

    set min_long -2147483648
................................................................................
    # when it should be parsed as a long type.
    list \
        [expr {" $min_long_str "}] \
        [expr {$min_long_str + 0}] \
        [expr {$min_long + 0}] \
        [expr {-2147483648 + 0}] \
        [expr {$min_long == $min_long_hex}] \
        [expr {int(-2147483648 - 1) == -0x80000001}] \

} {-2147483648 -2147483648 -2147483648 -2147483648 1 1}
test expr-33.3 {parse largest wide value} wideIs64bit {
    set max_wide_str 9223372036854775807
    set max_wide_hex "0x7FFFFFFFFFFFFFFF "

    # Convert to wide integer
................................................................................
} {-2}
test expr-34.11 {expr edge cases} {
    expr {$min / -2}
} {1073741824}
test expr-34.12 {expr edge cases} {
    expr {$min % -2}
} {0}
test expr-34.13 {expr edge cases} {
    expr {int($min / -1)}
} {2147483648}
test expr-34.14 {expr edge cases} {
    expr {$min % -1}
} {0}
test expr-34.15 {expr edge cases} {
    expr {-int($min * -1)}
} $min
test expr-34.16 {expr edge cases} {
    expr {-int(-$min)}
} $min
test expr-34.17 {expr edge cases} {
    expr {$min / 1}
} $min
test expr-34.18 {expr edge cases} {
    expr {$min % 1}
} {0}
................................................................................
	list [catch {testexprlongobj 0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-39.8 {Tcl_ExprLongObj handles overflows} testexprlongobj {
    testexprlongobj -0x80000000
} {This is a result: -2147483648}
test expr-39.9 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
    testexprlongobj -0x7fffffff
} {This is a result: -2147483647}
test expr-39.10 {Tcl_ExprLongObj handles overflows} \
    -constraints {testexprlongobj longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlongobj -0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}
................................................................................
	list [catch {testexprlongobj 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-39.14 {Tcl_ExprLongObj handles overflows} testexprlongobj {
    testexprlongobj -2147483648.
} {This is a result: -2147483648}
test expr-39.15 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
    testexprlongobj -2147483648.
} {This is a result: -2147483648}
test expr-39.16 {Tcl_ExprLongObj handles overflows} \
    -constraints {testexprlongobj longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlongobj 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}

Changes to tests/get.test.

60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
    list [catch {testgetint 4294967294} msg] $msg
} {0 -2}
test get-1.13 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint +4294967294} msg] $msg
} {0 -2}
test get-1.14 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint -4294967294} msg] $msg
} {0 2}

test get-2.1 {Tcl_GetInt procedure} {
    format %g 1.23
} {1.23}
test get-2.2 {Tcl_GetInt procedure} {
    format %g { 	 1.23 	}
} {1.23}







|







60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
    list [catch {testgetint 4294967294} msg] $msg
} {0 -2}
test get-1.13 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint +4294967294} msg] $msg
} {0 -2}
test get-1.14 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint -4294967294} msg] $msg
} {1 {integer value too large to represent}}

test get-2.1 {Tcl_GetInt procedure} {
    format %g 1.23
} {1.23}
test get-2.2 {Tcl_GetInt procedure} {
    format %g { 	 1.23 	}
} {1.23}