diff options
author | hobbs <hobbs> | 1999-08-10 05:09:16 (GMT) |
---|---|---|
committer | hobbs <hobbs> | 1999-08-10 05:09:16 (GMT) |
commit | 29e7f1a55250207e75c6e1e5ef5871a569514f62 (patch) | |
tree | 35e92a6781eae43644ccd1a1e63701c8280ab2de | |
parent | 5faf3edecdd8768936318d4aabac01542cb390eb (diff) | |
download | tcl-29e7f1a55250207e75c6e1e5ef5871a569514f62.zip tcl-29e7f1a55250207e75c6e1e5ef5871a569514f62.tar.gz tcl-29e7f1a55250207e75c6e1e5ef5871a569514f62.tar.bz2 |
1999-08-09 Jeff Hobbs <hobbs@scriptics.com>
* tests/string.test: added largest_int proc to adapt for >32 bit
machines and int overflow testing.
* tests/tcltest.test: fixed minor error in 8.2 result (from dgp)
-rw-r--r-- | ChangeLog | 4 | ||||
-rw-r--r-- | tests/string.test | 18 | ||||
-rwxr-xr-x | tests/tcltest.test | 5 |
3 files changed, 22 insertions, 5 deletions
@@ -1,5 +1,9 @@ 1999-08-09 Jeff Hobbs <hobbs@scriptics.com> + * tests/string.test: added largest_int proc to adapt for >32 bit + machines and int overflow testing. + * tests/tcltest.test: fixed minor error in 8.2 result (from dgp) + * doc/Object.3: clarified Tcl_DecrRefCount docs [Bug: 1952] * doc/array.n: clarified array pattern docs [Bug: 1330] * doc/clock.n: fixed clock docs [Bug: 693] diff --git a/tests/string.test b/tests/string.test index 951fd46..59cacae 100644 --- a/tests/string.test +++ b/tests/string.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: string.test,v 1.19 1999/07/09 02:11:56 stanton Exp $ +# RCS: @(#) $Id: string.test,v 1.20 1999/08/10 05:09:20 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -245,6 +245,15 @@ test string-5.15 {string index, bytearray object} { string compare $i1 $i2 } 0 +proc largest_int {} { + # This will give us what the largest valid int on this machine is, + # 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 {1 << [incr exp]}] } + return [expr {$int-1}] +} + test string-6.1 {string is, too few args} { list [catch {string is} msg] $msg } {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}} @@ -355,7 +364,8 @@ test string-6.36 {string is double, false} { list [string is double -fail var "\n"] $var } {0 0} test string-6.37 {string is double, false on int overflow} { - list [string is double -fail var 12345678901234567890] $var + # Make it the largest int recognizable, with one more digit for overflow + list [string is double -fail var [largest_int]0] $var } {0 -1} test string-6.38 {string is double, false on underflow} { catch {unset var} @@ -416,7 +426,7 @@ test string-6.54 {string is integer, false} { list [string is integer -fail var 123abc] $var } {0 3} test string-6.55 {string is integer, false on overflow} { - list [string is integer -fail var +12345678901234567890] $var + list [string is integer -fail var +[largest_int]0] $var } {0 -1} test string-6.56 {string is integer, false} { list [string is integer -fail var [expr double(1)]] $var @@ -528,6 +538,8 @@ test string-6.89 {string is xdigit} { list [string is xdigit -fail var 0123456789\u0061bcdefABCDEFg] $var } {0 22} +catch {rename largest_int {}} + test string-7.1 {string last, too few args} { list [catch {string last a} msg] $msg } {1 {wrong # args: should be "string last string1 string2 ?startIndex?"}} diff --git a/tests/tcltest.test b/tests/tcltest.test index 7c37ebe..f1f709d 100755 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -10,7 +10,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: tcltest.test,v 1.4 1999/07/30 19:10:47 jenn Exp $ +# RCS: @(#) $Id: tcltest.test,v 1.5 1999/08/10 05:09:20 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -230,7 +230,8 @@ test tcltest-8.1 {tcltest a.tcl -tmpdir a} { } {1 {}} test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} { catch {exec $::tcltest::tcltest a.tcl -tmpdir thisdirectoryisafile} msg - list [regexp "not a directory" $msg] + # The join is necessary because the message can be split on multiple lines + list [regexp "not a directory" [join $msg]] } {1} # Platform-specific attribute testing still needs to be set up |