One less crazy long/wide aunt in the attic [Bug 868489]

1 files changed, 53 insertions, 1 deletions

diff --git a/tests/obj.test b/tests/obj.test
index c802fb0..4d7a86b 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -11,14 +11,37 @@
 # 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.10 2004/06/24 10:34:12 dkf Exp $
+# RCS: @(#) $Id: obj.test,v 1.11 2004/09/10 21:29:42 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
+# 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
+
 testConstraint testobj [llength [info commands testobj]]
+testConstraint 32bit   [expr {$MAX_INT == 0x7fffffff}]
+testConstraint wideBiggerThanInt [expr {$MAX_WIDE > wide($MAX_INT)}]
 
 test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj {
     set r 1
@@ -596,6 +619,35 @@ test obj-32.1 {freeing very large object trees} {
     unset x
 } {}
 
+test obj-33.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-33.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-33.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-33.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-33.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-33.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-33.7 {integer overflow on input} {32bit wideBiggerThanInt} {
+    set x -0x10000; append x 0000
+    list [string is integer $x] [expr { wide($x) }]
+} {0 -4294967296}
+
 if {[testConstraint testobj]} {
     testobj freeallvars
 }