From 2f2b7f6ac7122f3b6be07e793e1658cdb5791aa2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 3 Sep 2018 12:53:15 +0000 Subject: Eliminate use of wideBiggerThanInt test constraint, since it's the same as {longIs32bit wideIs64bit}. And ... it's name is actually wrong ... Don't use int() any more in any test constraint, since it's semantics might change. We don't want the test constraints to change with it. (See: TIP# 514) Simplify implementation of wideIs64bit test constraint, just testing for 64-bit sign bit is enough. --- generic/tclTest.c | 22 ++++++++++++++++++++++ tests/compExpr-old.test | 4 ++-- tests/execute.test | 2 +- tests/expr-old.test | 3 ++- tests/expr.test | 7 +++---- tests/format.test | 12 +++++------- tests/get.test | 4 ++-- tests/obj.test | 14 +++++++------- tests/platform.test | 14 ++++---------- tests/scan.test | 3 +-- 10 files changed, 49 insertions(+), 36 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index ac01ecf..48b4761 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -293,6 +293,8 @@ static int TestgetassocdataCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestgetintCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); +static int TestlongsizeCmd(ClientData dummy, + Tcl_Interp *interp, int argc, const char **argv); static int TestgetplatformCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestgetvarfullnameCmd( @@ -645,6 +647,8 @@ Tcltest_Init( NULL, NULL); Tcl_CreateCommand(interp, "testgetint", TestgetintCmd, NULL, NULL); + Tcl_CreateCommand(interp, "testlongsize", TestlongsizeCmd, + NULL, NULL); Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testgetvarfullname", @@ -6936,6 +6940,24 @@ TestgetintCmd( } } +/* + * Used for determining sizeof(long) at script level. + */ +static int +TestlongsizeCmd( + ClientData dummy, + Tcl_Interp *interp, + int argc, + const char **argv) +{ + if (argc != 1) { + Tcl_AppendResult(interp, "wrong # args", NULL); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewIntObj((int)sizeof(long))); + return TCL_OK; +} + static int NREUnwind_callback( ClientData data[], diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index 0136ccd..798c92a 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -78,8 +78,8 @@ proc testIEEE {} { } testConstraint ieeeFloatingPoint [testIEEE] -testConstraint longIs32bit [expr {int(0x80000000) < 0}] -testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}] +testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] +testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}] # procedures used below diff --git a/tests/execute.test b/tests/execute.test index 6c277f8..2c54a71 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -34,7 +34,7 @@ testConstraint testobj [expr { && [llength [info commands teststringobj]] }] -testConstraint longIs32bit [expr {int(0x80000000) < 0}] +testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] testConstraint testexprlongobj [llength [info commands testexprlongobj]] # Tests for the omnibus TclExecuteByteCode function: diff --git a/tests/expr-old.test b/tests/expr-old.test index a73b77a..3192c74 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -22,7 +22,8 @@ catch [list package require -exact Tcltest [info patchlevel]] testConstraint testexprlong [llength [info commands testexprlong]] testConstraint testexprdouble [llength [info commands testexprdouble]] testConstraint testexprstring [llength [info commands testexprstring]] -testConstraint longIs32bit [expr {int(0x80000000) < 0}] +testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] +testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}] # Big test for correct ordering of data in [expr] diff --git a/tests/expr.test b/tests/expr.test index 713681a..0762cf2 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -21,10 +21,9 @@ catch [list package require -exact Tcltest [info patchlevel]] # Determine if "long int" type is a 32 bit number and if the wide # type is a 64 bit number on this machine. -testConstraint longIs32bit [expr {int(0x80000000) < 0}] -testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}] -testConstraint wideIs64bit \ - [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}] +testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] +testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}] +testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}] # Big test for correct ordering of data in [expr] diff --git a/tests/format.test b/tests/format.test index cdea545..1bf46a1 100644 --- a/tests/format.test +++ b/tests/format.test @@ -16,11 +16,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { } # %u output depends on word length, so this test is not portable. -testConstraint longIs32bit [expr {int(0x80000000) < 0}] -testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}] -testConstraint wideIs64bit \ - [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}] -testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}] +testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] +testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}] +testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}] testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}] test format-1.1 {integer formatting} { @@ -547,7 +545,7 @@ for {set i 290} {$i < 400} {incr i} { append b "x" } -test format-17.1 {testing %d with wide} {wideIs64bit wideBiggerThanInt} { +test format-17.1 {testing %d with wide} {longIs32bit wideIs64bit} { format %d 7810179016327718216 } 1819043144 test format-17.2 {testing %ld with wide} {wideIs64bit} { @@ -580,7 +578,7 @@ test format-18.1 {do not demote existing numeric values} { format %08x $b lappend result [expr {$a == $b}] } {1 1 1 1} -test format-18.2 {do not demote existing numeric values} {wideBiggerThanInt} { +test format-18.2 {do not demote existing numeric values} {longIs32bit wideIs64bit} { set a [expr {0xaaaaaaaaaa + 1}] set b 0xaaaaaaaaab list [format %08x $a] [expr {$a == $b}] diff --git a/tests/get.test b/tests/get.test index d6a7206..c381098 100644 --- a/tests/get.test +++ b/tests/get.test @@ -20,8 +20,8 @@ catch [list package require -exact Tcltest [info patchlevel]] testConstraint testgetint [llength [info commands testgetint]] testConstraint testdoubleobj [llength [info commands testdoubleobj]] -testConstraint longIs32bit [expr {int(0x80000000) < 0}] -testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}] +testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] +testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}] test get-1.1 {Tcl_GetInt procedure} testgetint { testgetint 44 { 22} diff --git a/tests/obj.test b/tests/obj.test index cb62d3f..d407669 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -20,8 +20,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} { catch [list package require -exact Tcltest [info patchlevel]] testConstraint testobj [llength [info commands testobj]] -testConstraint longIs32bit [expr {int(0x80000000) < 0}] -testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}] +testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] +testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}] test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj { set r 1 @@ -549,11 +549,11 @@ test obj-32.1 {freeing very large object trees} { unset x } {} -test obj-33.1 {integer overflow on input} {longIs32bit wideBiggerThanInt} { +test obj-33.1 {integer overflow on input} {longIs32bit wideIs64bit} { set x 0x8000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 2147483648} -test obj-33.2 {integer overflow on input} {longIs32bit wideBiggerThanInt} { +test obj-33.2 {integer overflow on input} {longIs32bit wideIs64bit} { set x 0xffff; append x ffff list [string is integer $x] [expr { wide($x) }] } {1 4294967295} @@ -561,15 +561,15 @@ test obj-33.3 {integer overflow on input} { set x 0x10000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {0 4294967296} -test obj-33.4 {integer overflow on input} {longIs32bit wideBiggerThanInt} { +test obj-33.4 {integer overflow on input} {longIs32bit wideIs64bit} { set x -0x8000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 -2147483648} -test obj-33.5 {integer overflow on input} {longIs32bit wideBiggerThanInt} { +test obj-33.5 {integer overflow on input} {longIs32bit wideIs64bit} { set x -0x8000; append x 0001 list [string is integer $x] [expr { wide($x) }] } {1 -2147483649} -test obj-33.6 {integer overflow on input} {longIs32bit wideBiggerThanInt} { +test obj-33.6 {integer overflow on input} {longIs32bit wideIs64bit} { set x -0xffff; append x ffff list [string is integer $x] [expr { wide($x) }] } {1 -4294967295} diff --git a/tests/platform.test b/tests/platform.test index fa533e8..5880fb9 100644 --- a/tests/platform.test +++ b/tests/platform.test @@ -25,6 +25,7 @@ namespace eval ::tcl::test::platform { catch [list package require -exact Tcltest [info patchlevel]] testConstraint testCPUID [llength [info commands testcpuid]] +testConstraint testlongsize [llength [info commands testlongsize]] test platform-1.0 {tcl_platform(engine)} { set tcl_platform(engine) @@ -39,16 +40,9 @@ test platform-1.1 {TclpSetVariables: tcl_platform} { set result } {byteOrder engine machine os osVersion pathSeparator platform pointerSize user wordSize} -# Test assumes twos-complement arithmetic, which is true of virtually -# everything these days. Note that this does *not* use wide(), and -# this is intentional since that could make Tcl's numbers wider than -# the machine-integer on some platforms... -test platform-2.1 {tcl_platform(wordSize) indicates size of native word} { - set result [expr {int(1 << (8 * $tcl_platform(wordSize) - 1))}] - # Result must be the largest bit in a machine word, which this checks - # without assuming how wide the word really is - list [expr {$result < 0}] [expr {$result ^ int($result - 1)}] -} {1 -1} +test platform-2.1 {tcl_platform(wordSize) indicates size of native word} testlongsize { + expr {$tcl_platform(wordSize) == [testlongsize]} +} {1} # On Windows/UNIX, test that the CPU ID works diff --git a/tests/scan.test b/tests/scan.test index 1f32b9f..5c38fff 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -85,8 +85,7 @@ proc testIEEE {} { } testConstraint ieeeFloatingPoint [testIEEE] -testConstraint wideIs64bit \ - [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}] +testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}] test scan-1.1 {BuildCharSet, CharInSet} { list [scan foo {%[^o]} x] $x -- cgit v0.12