diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/obj.test | 68 |
1 files changed, 67 insertions, 1 deletions
diff --git a/tests/obj.test b/tests/obj.test index c4ec7d4..7b25f91 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: obj.test,v 1.7 2002/04/26 08:43:38 dkf Exp $ +# RCS: @(#) $Id: obj.test,v 1.7.2.1 2004/09/10 21:52:37 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -25,6 +25,33 @@ if {[info commands testobj] == {}} { return } +# Procedure to determine the integer range of the machine + +proc int_range {} { + for { set MIN_INT 1 } { $MIN_INT > 0 } {} { + set MIN_INT [expr { $MIN_INT << 1 }] + } + set MAX_INT [expr { ~ $MIN_INT }] + return [list $MIN_INT $MAX_INT] +} + +# Procedure to determine the range of wide integers on the machine. + +proc wide_range {} { + for { set MIN_WIDE [expr { wide(1) }] } { $MIN_WIDE > wide(0) } {} { + set MIN_WIDE [expr { $MIN_WIDE << 1 }] + } + set MAX_WIDE [expr { ~ $MIN_WIDE }] + return [list $MIN_WIDE $MAX_WIDE] +} + +foreach { MIN_INT MAX_INT } [int_range] break +foreach { MIN_WIDE MAX_WIDE } [wide_range] break +::tcltest::testConstraint 32bit \ + [expr { $MAX_INT == 0x7fffffff }] +::tcltest::testConstraint wideBiggerThanInt \ + [expr { $MAX_WIDE > wide($MAX_INT) }] + test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} { set r 1 foreach {t} { @@ -597,8 +624,47 @@ test obj-31.6 {regenerate string rep of "end--bigInteger"} {nonPortable} { testobj invalidateStringRep 1 } end--2147483648 +test obj-32.1 {integer overflow on input} {32bit wideBiggerThanInt} { + set x 0x8000; append x 0000 + list [string is integer $x] [expr { wide($x) }] +} {1 2147483648} + +test obj-32.2 {integer overflow on input} {32bit wideBiggerThanInt} { + set x 0xffff; append x ffff + list [string is integer $x] [expr { wide($x) }] +} {1 4294967295} + +test obj-32.3 {integer overflow on input} {32bit wideBiggerThanInt} { + set x 0x10000; append x 0000 + list [string is integer $x] [expr { wide($x) }] +} {0 4294967296} + +test obj-32.4 {integer overflow on input} {32bit wideBiggerThanInt} { + set x -0x8000; append x 0000 + list [string is integer $x] [expr { wide($x) }] +} {1 -2147483648} + +test obj-32.5 {integer overflow on input} {32bit wideBiggerThanInt} { + set x -0x8000; append x 0001 + list [string is integer $x] [expr { wide($x) }] +} {1 -2147483649} + +test obj-32.6 {integer overflow on input} {32bit wideBiggerThanInt} { + set x -0xffff; append x ffff + list [string is integer $x] [expr { wide($x) }] +} {1 -4294967295} + +test obj-32.7 {integer overflow on input} {32bit wideBiggerThanInt} { + set x -0x10000; append x 0000 + list [string is integer $x] [expr { wide($x) }] +} {0 -4294967296} + testobj freeallvars # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: |