summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-09-10 21:52:36 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-09-10 21:52:36 (GMT)
commita69c427499edc0f882f3f6a3341f93f6310c7f1c (patch)
treee7bd5b15e987acefee05f747ac039c442fc574f9 /tests
parent7a17535a4cac473a9dfab8b3816e06908e9a918f (diff)
downloadtcl-a69c427499edc0f882f3f6a3341f93f6310c7f1c.zip
tcl-a69c427499edc0f882f3f6a3341f93f6310c7f1c.tar.gz
tcl-a69c427499edc0f882f3f6a3341f93f6310c7f1c.tar.bz2
One less crazy long/wide aunt in the attic... [Bug 868489]
Diffstat (limited to 'tests')
-rw-r--r--tests/obj.test68
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: