summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/binary.test67
-rw-r--r--tests/dict.test9
-rw-r--r--tests/expr-old.test100
-rw-r--r--tests/expr.test248
-rw-r--r--tests/format.test4
-rw-r--r--tests/obj.test20
-rw-r--r--tests/scan.test83
-rw-r--r--tests/string.test4
8 files changed, 511 insertions, 24 deletions
diff --git a/tests/binary.test b/tests/binary.test
index 2bd3169..e2ad12e 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: binary.test,v 1.24 2005/09/27 15:35:50 dkf Exp $
+# RCS: @(#) $Id: binary.test,v 1.25 2005/10/08 14:42:54 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -2141,6 +2141,66 @@ proc testIEEE {} {
testConstraint ieeeFloatingPoint [testIEEE]
+# scan/format infinities
+
+test binary-62.1 {infinity} ieeeFloatingPoint {
+ binary scan [binary format q Infinity] w w
+ format 0x%016lx $w
+} 0x7ff0000000000000
+test binary-62.2 {infinity} ieeeFloatingPoint {
+ binary scan [binary format q -Infinity] w w
+ format 0x%016lx $w
+} 0xfff0000000000000
+test binary-62.3 {infinity} ieeeFloatingPoint {
+ binary scan [binary format q Inf] w w
+ format 0x%016lx $w
+} 0x7ff0000000000000
+test binary-62.4 {infinity} ieeeFloatingPoint {
+ binary scan [binary format q -Infinity] w w
+ format 0x%016lx $w
+} 0xfff0000000000000
+test binary-62.5 {infinity} ieeeFloatingPoint {
+ binary scan [binary format w 0x7ff0000000000000] q d
+ set d
+} Inf
+test binary-62.6 {infinity} ieeeFloatingPoint {
+ binary scan [binary format w 0xfff0000000000000] q d
+ set d
+} -Inf
+
+# scan/format Not-a-Number
+
+test binary-63.1 {NaN} ieeeFloatingPoint {
+ binary scan [binary format q NaN] w w
+ format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
+} 0x7ff0000000000000
+test binary-63.2 {NaN} ieeeFloatingPoint {
+ binary scan [binary format q -NaN] w w
+ format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
+} 0xfff0000000000000
+test binary-63.3 {NaN} ieeeFloatingPoint {
+ binary scan [binary format q NaN(3123456789aBc)] w w
+ format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
+} 0x7ff3123456789abc
+test binary-63.4 {NaN} ieeeFloatingPoint {
+ binary scan [binary format q {NaN( 3123456789aBc)}] w w
+ format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
+} 0x7ff3123456789abc
+test binary-64.1 {NaN} \
+ -constraints ieeeFloatingPoint \
+ -body {
+ binary scan [binary format w 0x7ff8000000000000] q d
+ set d
+ } \
+ -match glob -result NaN*
+test binary-64.2 {NaN} \
+ -constraints ieeeFloatingPoint \
+ -body {
+ binary scan [binary format w 0x7ff0123456789aBc] q d
+ set d
+ } \
+ -match glob -result NaN(*123456789abc)
+
test binary-65.1 {largest significand} ieeeFloatingPoint {
binary scan [binary format w 0x3fcfffffffffffff] q d
set d
@@ -2178,7 +2238,10 @@ test binary-65.8 {largest significand} ieeeFloatingPoint {
set d
} 18014398509481988.0
-
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/dict.test b/tests/dict.test
index 090142e..1733424 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: dict.test,v 1.13 2005/07/21 21:49:08 dkf Exp $
+# RCS: @(#) $Id: dict.test,v 1.14 2005/10/08 14:42:54 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -317,6 +317,13 @@ test dict-11.16 {dict incr command: compilation} {
}
dicttest
} {1 1 2 3}
+test dict-11.17 {dict incr command: compilation} {
+ proc dicttest {} {
+ set dictv {a 1}
+ dict incr dictv a 2
+ }
+ dicttest
+} {a 3}
test dict-12.1 {dict lappend command} {
set dictv {a a}
diff --git a/tests/expr-old.test b/tests/expr-old.test
index bb5a4fd..28b4abb 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -13,7 +13,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: expr-old.test,v 1.27 2005/09/29 23:16:29 hobbs Exp $
+# RCS: @(#) $Id: expr-old.test,v 1.28 2005/10/08 14:42:54 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -1018,7 +1018,9 @@ test expr-old-36.16 {ExprLooksLikeInt procedure} {
} {1 {can't use integer value too large to represent as operand of "+"}}
testConstraint testexprlong [llength [info commands testexprlong]]
+testConstraint testexprdouble [llength [info commands testexprdouble]]
testConstraint testexprstring [llength [info commands testexprstring]]
+testConstraint longIs32bit [expr {int(0x80000000) < 0}]
test expr-old-37.1 {Check that Tcl_ExprLong doesn't modify interpreter result if no error} testexprlong {
testexprlong 4+1
@@ -1028,6 +1030,98 @@ test expr-old-37.2 {Tcl_ExprLong handles wide ints gracefully} testexprlong {
testexprlong wide(1)+2
} {This is a result: 3}
+test expr-old-37.3 {Tcl_ExprLong on the empty string} testexprlong {
+ testexprlong ""
+} {This is a result: 0}
+test expr-old-37.4 {Tcl_ExprLong coerces doubles} testexprlong {
+ testexprlong 3+.14159
+} {This is a result: 3}
+test expr-old-37.5 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
+ testexprlong 0x80000000
+} {This is a result: -2147483648}
+test expr-old-37.6 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
+ testexprlong 0xffffffff
+} {This is a result: -1}
+test expr-old-37.7 {Tcl_ExprLong handles overflows} \
+ -constraints {testexprlong longIs32bit} \
+ -match glob \
+ -body {
+ list [catch {testexprlong 0x100000000} result] $result
+ } \
+ -result {1 {integer value too large to represent*}}
+test expr-old-37.8 {Tcl_ExprLong handles overflows} testexprlong {
+ testexprlong -0x80000000
+} {This is a result: -2147483648}
+test expr-old-37.9 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
+ testexprlong -0xffffffff
+} {This is a result: 1}
+test expr-old-37.10 {Tcl_ExprLong handles overflows} \
+ -constraints {testexprlong longIs32bit} \
+ -match glob \
+ -body {
+ list [catch {testexprlong -0x100000000} result] $result
+ } \
+ -result {1 {integer value too large to represent*}}
+test expr-old-37.11 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
+ testexprlong 2147483648.
+} {This is a result: -2147483648}
+test expr-old-37.12 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
+ testexprlong 4294967295.
+} {This is a result: -1}
+test expr-old-37.13 {Tcl_ExprLong handles overflows} \
+ -constraints {testexprlong longIs32bit} \
+ -match glob \
+ -body {
+ list [catch {testexprlong 4294967296.} result] $result
+ } \
+ -result {1 {integer value too large to represent*}}
+test expr-old-37.14 {Tcl_ExprLong handles overflows} testexprlong {
+ testexprlong -2147483648.
+} {This is a result: -2147483648}
+test expr-old-37.15 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
+ testexprlong -4294967295.
+} {This is a result: 1}
+test expr-old-37.16 {Tcl_ExprLong handles overflows} \
+ -constraints {testexprlong longIs32bit} \
+ -match glob \
+ -body {
+ list [catch {testexprlong 4294967296.} result] $result
+ } \
+ -result {1 {integer value too large to represent*}}
+
+test expr-old-37.17 {Check that Tcl_ExprDouble doesn't modify interpreter result if no error} testexprdouble {
+ testexprdouble 4.+1.
+} {This is a result: 5.0}
+#Check for [Bug 1109484]
+test expr-old-37.18 {Tcl_ExprDouble on the empty string} testexprdouble {
+ testexprdouble ""
+} {This is a result: 0.0}
+test expr-old-37.19 {Tcl_ExprDouble coerces wides} testexprdouble {
+ testexprdouble 1[string repeat 0 17]
+} {This is a result: 1e+17}
+test expr-old-37.20 {Tcl_ExprDouble coerces bignums} testexprdouble {
+ testexprdouble 1[string repeat 0 38]
+} {This is a result: 1e+38}
+test expr-old-37.21 {Tcl_ExprDouble handles overflows} testexprdouble {
+ testexprdouble 17976931348623157[string repeat 0 292].
+} {This is a result: 1.7976931348623157e+308}
+test expr-old-37.22 {Tcl_ExprDouble handles overflows that look like int} \
+ testexprdouble {
+ testexprdouble 17976931348623157[string repeat 0 292]
+ } {This is a result: 1.7976931348623157e+308}
+test expr-old-37.23 {Tcl_ExprDouble handles overflows} \
+ ieeeFloatingPoint&&testexprdouble {
+ testexprdouble 17976931348623165[string repeat 0 292].
+ } {This is a result: Inf}
+test expr-old-37.24 {Tcl_ExprDouble handles overflows that look like int} \
+ ieeeFloatingPoint&&testexprdouble {
+ testexprdouble 17976931348623165[string repeat 0 292]
+ } {This is a result: Inf}
+test expr-old-37.25 {Tcl_ExprDouble and NaN} \
+ ieeeFloatingPoint&&testexprdouble {
+ list [catch {testexprdouble 0.0/0.0} result] $result
+ } {1 {floating point value is Not a Number}}
+
test expr-old-38.1 {Verify Tcl_ExprString's basic operation} testexprstring {
list [testexprstring "1+4"] [testexprstring "2*3+4.2"] \
[catch {testexprstring "1+"} msg] $msg
@@ -1109,3 +1203,7 @@ if {(4195835.0 - (4195835.0/3145727.0)*3145727.0) == 256.0} {
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/expr.test b/tests/expr.test
index 50159c0..92308b9 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: expr.test,v 1.44 2005/08/29 17:54:22 kennykb Exp $
+# RCS: @(#) $Id: expr.test,v 1.45 2005/10/08 14:42:54 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -26,7 +26,8 @@ testConstraint testmathfunctions [expr {
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
-testConstraint wideIs64bit [expr {(0x80000000 > 0) && (0x8000000000000000 < 0)}]
+testConstraint wideIs64bit \
+ [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
# Big test for correct ordering of data in [expr]
@@ -54,6 +55,8 @@ proc testIEEE {} {
ieeeValues(+Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
ieeeValues(NaN)
+ binary scan \x00\x00\x00\x00\x00\x00\xf8\xff d \
+ ieeeValues(-NaN)
set ieeeValues(littleEndian) 1
return 1
}
@@ -76,6 +79,8 @@ proc testIEEE {} {
ieeeValues(+Infinity)
binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
ieeeValues(NaN)
+ binary scan \xff\xf8\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(-NaN)
set ieeeValues(littleEndian) 0
return 1
}
@@ -6239,6 +6244,245 @@ test expr-38.1 {abs of smallest 32-bit integer [Bug 1241572]} {wideIs64bit} {
expr {abs(-2147483648)}
} 2147483648
+testConstraint testexprlongobj [llength [info commands testexprlongobj]]
+testConstraint testexprdoubleobj [llength [info commands testexprdoubleobj]]
+
+test expr-39.1 {Check that Tcl_ExprLongObj doesn't modify interpreter result if no error} testexprlongobj {
+ testexprlongobj 4+1
+} {This is a result: 5}
+#Check for [Bug 1109484]
+test expr-39.2 {Tcl_ExprLongObj handles wide ints gracefully} testexprlongobj {
+ testexprlongobj wide(1)+2
+} {This is a result: 3}
+
+test expr-39.3 {Tcl_ExprLongObj on the empty string} \
+ -constraints testexprlongobj \
+ -body {
+ list [catch {testexprlongobj ""} result] $result
+ } \
+ -match glob \
+ -result {1 {syntax error*}}
+test expr-39.4 {Tcl_ExprLongObj coerces doubles} testexprlongobj {
+ testexprlongobj 3+.14159
+} {This is a result: 3}
+test expr-39.5 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
+ testexprlongobj 0x80000000
+} {This is a result: -2147483648}
+test expr-39.6 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
+ testexprlongobj 0xffffffff
+} {This is a result: -1}
+test expr-39.7 {Tcl_ExprLongObj handles overflows} \
+ -constraints {testexprlongobj longIs32bit} \
+ -match glob \
+ -body {
+ 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*}}
+test expr-39.11 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
+ testexprlongobj 2147483648.
+} {This is a result: -2147483648}
+test expr-39.12 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
+ testexprlongobj 4294967295.
+} {This is a result: -1}
+test expr-39.13 {Tcl_ExprLongObj handles overflows} \
+ -constraints {testexprlongobj longIs32bit} \
+ -match glob \
+ -body {
+ 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*}}
+
+test expr-39.17 {Check that Tcl_ExprDoubleObj doesn't modify interpreter result if no error} testexprdoubleobj {
+ testexprdoubleobj 4.+1.
+} {This is a result: 5.0}
+#Check for [Bug 1109484]
+test expr-39.18 {Tcl_ExprDoubleObj on the empty string} \
+ -constraints testexprdoubleobj \
+ -match glob \
+ -body {
+ list [catch {testexprdoubleobj ""} result] $result
+ } \
+ -result {1 {syntax error*}}
+test expr-39.19 {Tcl_ExprDoubleObj coerces wides} testexprdoubleobj {
+ testexprdoubleobj 1[string repeat 0 17]
+} {This is a result: 1e+17}
+test expr-39.20 {Tcl_ExprDoubleObj coerces bignums} testexprdoubleobj {
+ testexprdoubleobj 1[string repeat 0 38]
+} {This is a result: 1e+38}
+test expr-39.21 {Tcl_ExprDoubleObj handles overflows} \
+ testexprdoubleobj&&ieeeFloatingPoint {
+ testexprdoubleobj 17976931348623157[string repeat 0 292].
+ } {This is a result: 1.7976931348623157e+308}
+test expr-39.22 {Tcl_ExprDoubleObj handles overflows that look like int} \
+ testexprdoubleobj&&ieeeFloatingPoint {
+ testexprdoubleobj 17976931348623157[string repeat 0 292]
+ } {This is a result: 1.7976931348623157e+308}
+test expr-39.23 {Tcl_ExprDoubleObj handles overflows} \
+ testexprdoubleobj&&ieeeFloatingPoint {
+ testexprdoubleobj 17976931348623165[string repeat 0 292].
+ } {This is a result: Inf}
+test expr-39.24 {Tcl_ExprDoubleObj handles overflows that look like int} \
+ testexprdoubleobj&&ieeeFloatingPoint {
+ testexprdoubleobj 17976931348623165[string repeat 0 292]
+ } {This is a result: Inf}
+test expr-39.25 {Tcl_ExprDoubleObj and NaN} \
+ testexprdoubleobj&&ieeeFloatingPoint {
+ list [catch {testexprdoubleobj 0.0/0.0} result] $result
+ } {1 {floating point value is Not a Number}}
+
+test expr-40.1 {large octal shift} {
+ expr 0100000000000000000000000000000000
+} [expr 0x1000000000000000000000000]
+test expr-40.2 {large octal shift} {
+ expr 0100000000000000000000000000000001
+} [expr 0x1000000000000000000000001]
+
+test expr-41.1 {exponent overflow} {
+ expr 1.0e2147483630
+} Inf
+test expr-41.2 {exponent underflow} {
+ expr 1.0e-2147483630
+} 0.0
+
+test expr-42.1 {denormals} ieeeFloatingPoint {
+ expr 7e-324
+} 5e-324
+
+# TIP 114
+
+test expr-43.1 {0b notation} {
+ expr 0b0
+} 0
+test expr-43.2 {0b notation} {
+ expr 0b1
+} 1
+test expr-43.3 {0b notation} {
+ expr 0b10
+} 2
+test expr-43.4 {0b notation} {
+ expr 0b11
+} 3
+test expr-43.5 {0b notation} {
+ expr 0b100
+} 4
+test expr-43.6 {0b notation} {
+ expr 0b101
+} 5
+test expr-43.7 {0b notation} {
+ expr 0b1000
+} 8
+test expr-43.8 {0b notation} {
+ expr 0b1001
+} 9
+test expr-43.9 {0b notation} {
+ expr 0b1[string repeat 0 31]
+} 2147483648
+test expr-43.10 {0b notation} {
+ expr 0b1[string repeat 0 30]1
+} 2147483649
+test expr-43.11 {0b notation} {
+ expr 0b[string repeat 1 64]
+} 18446744073709551615
+test expr-43.12 {0b notation} {
+ expr 0b1[string repeat 0 64]
+} 18446744073709551616
+test expr-43.13 {0b notation} {
+ expr 0b1[string repeat 0 63]1
+} 18446744073709551617
+
+test expr-44.1 {0o notation} {
+ expr 0o0
+} 0
+test expr-44.2 {0o notation} {
+ expr 0o1
+} 1
+test expr-44.3 {0o notation} {
+ expr 0o7
+} 7
+test expr-44.4 {0o notation} {
+ expr 0o10
+} 8
+test expr-44.5 {0o notation} {
+ expr 0o11
+} 9
+test expr-44.6 {0o notation} {
+ expr 0o100
+} 64
+test expr-44.7 {0o notation} {
+ expr 0o101
+} 65
+test expr-44.8 {0o notation} {
+ expr 0o1000
+} 512
+test expr-44.9 {0o notation} {
+ expr 0o1001
+} 513
+test expr-44.10 {0o notation} {
+ expr 0o1[string repeat 7 21]
+} 18446744073709551615
+test expr-44.11 {0o notation} {
+ expr 0o2[string repeat 0 21]
+} 18446744073709551616
+test expr-44.12 {0o notation} {
+ expr 0o2[string repeat 0 20]1
+} 18446744073709551617
+
+# TIP 237 again
+
+test expr-45.1 {entier} {
+ expr entier(0)
+} 0
+test expr-45.2 {entier} {
+ expr entier(0.5)
+} 0
+test expr-45.3 {entier} {
+ expr entier(1.0)
+} 1
+test expr-45.4 {entier} {
+ expr entier(1.5)
+} 1
+test expr-45.5 {entier} {
+ expr entier(2.0)
+} 2
+test expr-45.6 {entier} {
+ expr entier(1e+22)
+} 10000000000000000000000
+test expr-45.7 {entier} {
+ list [catch {expr entier(Inf)} result] $result
+} {1 {integer value too large to represent}}
+test expr-45.8 {entier} ieeeFloatingPoint {
+ list [catch {expr {entier($ieeeValues(NaN))}} result] $result
+} {1 {floating point value is Not a Number}}
+test expr-45.9 {entier} ieeeFloatingPoint {
+ list [catch {expr {entier($ieeeValues(-NaN))}} result] $result
+} {1 {floating point value is Not a Number}}
+
test expr-46.1 {round() rounds to +-infinity} {
expr round(0.5)
} 1
diff --git a/tests/format.test b/tests/format.test
index a6e2242..86f4665 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: format.test,v 1.21 2005/07/28 18:42:32 dgp Exp $
+# RCS: @(#) $Id: format.test,v 1.22 2005/10/08 14:42:54 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -504,7 +504,7 @@ for {set i 290} {$i < 400} {incr i} {
}
::tcltest::testConstraint wideIs64bit \
- [expr {(0x80000000 > 0) && (0x8000000000000000 < 0)}]
+ [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
::tcltest::testConstraint wideBiggerThanInt \
[expr {wide(0x80000000) != int(0x80000000)}]
diff --git a/tests/obj.test b/tests/obj.test
index e905698..51c9e43 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.18 2005/07/28 18:42:32 dgp Exp $
+# RCS: @(#) $Id: obj.test,v 1.19 2005/10/08 14:42:54 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -26,18 +26,14 @@ test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} tes
set r 1
foreach {t} {
{array search}
- bignum
bytearray
bytecode
cmdName
dict
- double
end-offset
- int
nsName
regexp
string
- wideInt
} {
set first [string first $t [testobj types]]
set r [expr {$r && ($first != -1)}]
@@ -52,17 +48,19 @@ test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testintobj set 1 12]
- lappend result [testobj convert 1 double]
+ lappend result [testobj convert 1 bytearray]
lappend result [testobj type 1]
lappend result [testobj refcount 1]
-} {{} 12 12 double 3}
+} {{} 12 12 bytearray 3}
test obj-3.1 {Tcl_ConvertToType error} testobj {
- list [testdoubleobj set 1 12.34] [catch {testobj convert 1 int} msg] $msg
-} {12.34 1 {expected integer but got "12.34"}}
+ list [testdoubleobj set 1 12.34] \
+ [catch {testobj convert 1 end-offset} msg] \
+ $msg
+} {12.34 1 {bad index "12.34": must be end?[+-]integer?}}
test obj-3.2 {Tcl_ConvertToType error, "empty string" object} testobj {
- list [testobj newobj 1] [catch {testobj convert 1 int} msg] $msg
-} {{} 1 {expected integer but got ""}}
+ list [testobj newobj 1] [catch {testobj convert 1 end-offset} msg] $msg
+} {{} 1 {bad index "": must be end?[+-]integer?}}
test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} testobj {
set result ""
diff --git a/tests/scan.test b/tests/scan.test
index 2bb6626..97c6d04 100644
--- a/tests/scan.test
+++ b/tests/scan.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: scan.test,v 1.17 2005/07/28 18:42:33 dgp Exp $
+# RCS: @(#) $Id: scan.test,v 1.18 2005/10/08 14:42:54 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -19,7 +19,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
}
::tcltest::testConstraint wideIs64bit \
- [expr {(0x80000000 > 0) && (0x8000000000000000 < 0)}]
+ [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
test scan-1.1 {BuildCharSet, CharInSet} {
list [scan foo {%[^o]} x] $x
@@ -341,9 +341,10 @@ test scan-4.61 {Tcl_ScanObjCmd, set errors} {
# procedure that returns the range of integers
proc int_range {} {
- for { set MIN_INT 1 } { $MIN_INT > 0 } {} {
+ for { set MIN_INT 1 } { int($MIN_INT) > 0 } {} {
set MIN_INT [expr { $MIN_INT << 1 }]
}
+ set MIN_INT [expr {int($MIN_INT)}]
set MAX_INT [expr { ~ $MIN_INT }]
return [list $MIN_INT $MAX_INT]
}
@@ -679,6 +680,82 @@ test scan-13.8 {Tcl_ScanObjCmd, inline XPG case lots of arguments} {
list [llength $msg] [lindex $msg 99] [lindex $msg 4] [lindex $msg 199]
} {200 10 20 30}
+# Big test for correct ordering of data in [expr]
+
+proc testIEEE {} {
+ variable ieeeValues
+ binary scan [binary format dd -1.0 1.0] c* c
+ switch -exact -- $c {
+ {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
+ # little endian
+ binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \
+ ieeeValues(-Infinity)
+ binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
+ ieeeValues(-Normal)
+ binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
+ ieeeValues(-Subnormal)
+ binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \
+ ieeeValues(-0)
+ binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(+0)
+ binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
+ ieeeValues(+Subnormal)
+ binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \
+ ieeeValues(+Normal)
+ binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
+ ieeeValues(+Infinity)
+ binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
+ ieeeValues(NaN)
+ set ieeeValues(littleEndian) 1
+ return 1
+ }
+ {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
+ binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(-Infinity)
+ binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(-Normal)
+ binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(-Subnormal)
+ binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(-0)
+ binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(+0)
+ binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(+Subnormal)
+ binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(+Normal)
+ binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(+Infinity)
+ binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(NaN)
+ set ieeeValues(littleEndian) 0
+ return 1
+ }
+ default {
+ return 0
+ }
+ }
+}
+
+testConstraint ieeeFloatingPoint [testIEEE]
+
+# scan infinities - not working
+
+test scan-14.1 {infinity} ieeeFloatingPoint {
+ scan Inf %g d
+ set d
+} Inf
+test scan-14.2 {infinity} ieeeFloatingPoint {
+ scan -Inf %g d
+ set d
+} -Inf
+
+# TODO - also need to scan NaN's
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End: \ No newline at end of file
diff --git a/tests/string.test b/tests/string.test
index 2402657..1969c59 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -12,7 +12,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: string.test,v 1.51 2005/07/28 18:42:33 dgp Exp $
+# RCS: @(#) $Id: string.test,v 1.52 2005/10/08 14:42:54 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -293,7 +293,7 @@ proc largest_int {} {
# so we can test for overflow properly below on >32 bit systems
set int 1
set exp 7; # assume we get at least 8 bits
- while {$int > 0} { set int [expr {wide(1) << [incr exp]}] }
+ while {wide($int) > 0} { set int [expr {wide(1) << [incr exp]}] }
return [expr {$int-1}]
}