diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/binary.test | 67 | ||||
| -rw-r--r-- | tests/dict.test | 9 | ||||
| -rw-r--r-- | tests/expr-old.test | 100 | ||||
| -rw-r--r-- | tests/expr.test | 248 | ||||
| -rw-r--r-- | tests/format.test | 4 | ||||
| -rw-r--r-- | tests/obj.test | 20 | ||||
| -rw-r--r-- | tests/scan.test | 83 | ||||
| -rw-r--r-- | tests/string.test | 4 |
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}] } |