diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/cmdIL.test | 4 | ||||
| -rw-r--r-- | tests/compile.test | 8 | ||||
| -rw-r--r-- | tests/lindex.test | 42 | ||||
| -rw-r--r-- | tests/linsert.test | 4 | ||||
| -rw-r--r-- | tests/lrange.test | 10 | ||||
| -rw-r--r-- | tests/lreplace.test | 8 | ||||
| -rw-r--r-- | tests/lsearch.test | 6 | ||||
| -rw-r--r-- | tests/lset.test | 10 | ||||
| -rw-r--r-- | tests/regexp.test | 32 | ||||
| -rw-r--r-- | tests/regexpComp.test | 4 | ||||
| -rw-r--r-- | tests/string.test | 38 | ||||
| -rw-r--r-- | tests/stringComp.test | 10 | ||||
| -rw-r--r-- | tests/util.test | 186 |
13 files changed, 286 insertions, 76 deletions
diff --git a/tests/cmdIL.test b/tests/cmdIL.test index 156c4dd..443dd78 100644 --- a/tests/cmdIL.test +++ b/tests/cmdIL.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: cmdIL.test,v 1.23 2004/10/14 17:20:11 dkf Exp $ +# RCS: @(#) $Id: cmdIL.test,v 1.24 2005/04/29 20:49:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -59,7 +59,7 @@ test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} { } {1 {"-index" option must be followed by list index}} test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} { list [catch {lsort -index foo {1 3 2 5}} msg] $msg -} {1 {bad index "foo": must be integer or end?-integer?}} +} {1 {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}} test cmdIL-1.13 {Tcl_LsortObjCmd procedure, -index option} { lsort -index end -integer {{2 25} {10 20 50 100} {3 16 42} 1} } {1 {2 25} {3 16 42} {10 20 50 100}} diff --git a/tests/compile.test b/tests/compile.test index 6a2f16e..4cdc3be 100644 --- a/tests/compile.test +++ b/tests/compile.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: compile.test,v 1.36 2005/01/14 15:27:53 dkf Exp $ +# RCS: @(#) $Id: compile.test,v 1.37 2005/04/29 20:49:44 dgp Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -236,15 +236,15 @@ test compile-11.1 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { lindex a bogus } list [catch {p} msg] $msg -} {1 {bad index "bogus": must be integer or end?-integer?}} +} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { proc p {} { set r [list foobar] ; string index a bogus } list [catch {p} msg] $msg -} {1 {bad index "bogus": must be integer or end?-integer?}} +} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { proc p {} { set r [list foobar] ; string index a 09 } list [catch {p} msg] $msg -} {1 {bad index "09": must be integer or end?-integer? (looks like invalid octal number)}} +} {1 {bad index "09": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { proc p {} { set r [list foobar] ; array set var {one two many} } list [catch {p} msg] $msg diff --git a/tests/lindex.test b/tests/lindex.test index 63d1548..2e180c2 100644 --- a/tests/lindex.test +++ b/tests/lindex.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: lindex.test,v 1.11 2003/11/14 20:44:46 dgp Exp $ +# RCS: @(#) $Id: lindex.test,v 1.12 2005/04/29 20:49:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -49,7 +49,7 @@ test lindex-2.3 {multiple indices in list} testevalex { test lindex-2.4 {malformed index list} testevalex { set x \{ list [catch { testevalex {lindex {a b c} $x} } result] $result -} {1 bad\ index\ \"\{\":\ must\ be\ integer\ or\ end?-integer?} +} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?} # Indices that are integers or convertible to integers @@ -76,12 +76,12 @@ test lindex-3.4 {integer 3} testevalex { test lindex-3.5 {bad octal} testevalex { set x 08 list [catch { testevalex {lindex {a b c} $x} } result] $result -} "1 {bad index \"08\": must be integer or end?-integer? (looks like invalid octal number)}" +} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test lindex-3.6 {bad octal} testevalex { set x -09 list [catch { testevalex {lindex {a b c} $x} } result] $result -} "1 {bad index \"-09\": must be integer or end?-integer? (looks like invalid octal number)}" +} {1 {bad index "-09": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test lindex-3.7 {indexes don't shimmer wide ints} { set x [expr {(wide(1)<<31) - 2}] @@ -118,31 +118,31 @@ test lindex-4.5 {index = end-3} testevalex { test lindex-4.6 {bad octal} testevalex { set x end-08 list [catch { testevalex {lindex {a b c} $x} } result] $result -} "1 {bad index \"end-08\": must be integer or end?-integer? (looks like invalid octal number)}" +} {1 {bad index "end-08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test lindex-4.7 {bad octal} testevalex { set x end--09 list [catch { testevalex {lindex {a b c} $x} } result] $result -} "1 {bad index \"end--09\": must be integer or end?-integer?}" +} {1 {bad index "end--09": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-4.8 {bad integer, not octal} testevalex { set x end-0a2 list [catch { testevalex {lindex {a b c} $x} } result] $result -} "1 {bad index \"end-0a2\": must be integer or end?-integer?}" +} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}} -test lindex-4.9 {incomplete end} testevalex { - set x en +test lindex-4.9 {obsolete test} testevalex { + set x end list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } {c c} test lindex-4.10 {incomplete end-} testevalex { set x end- list [catch { testevalex {lindex {a b c} $x} } result] $result -} "1 {bad index \"end-\": must be integer or end?-integer?}" +} {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-5.1 {bad second index} testevalex { list [catch { testevalex {lindex {a b c} 0 0a2} } result] $result -} "1 {bad index \"0a2\": must be integer or end?-integer?}" +} {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-5.2 {good second index} testevalex { testevalex {lindex {{a b c} {d e f} {g h i}} 1 2} @@ -245,7 +245,7 @@ test lindex-10.3 {multiple indices in list} { test lindex-10.4 {malformed index list} { set x \{ list [catch { lindex {a b c} $x } result] $result -} {1 bad\ index\ \"\{\":\ must\ be\ integer\ or\ end?-integer?} +} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?} # Indices that are integers or convertible to integers @@ -284,12 +284,12 @@ test lindex-11.4 {integer 3} { test lindex-11.5 {bad octal} { set x 08 list [catch { lindex {a b c} $x } result] $result -} "1 {bad index \"08\": must be integer or end?-integer? (looks like invalid octal number)}" +} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test lindex-11.6 {bad octal} { set x -09 list [catch { lindex {a b c} $x } result] $result -} "1 {bad index \"-09\": must be integer or end?-integer? (looks like invalid octal number)}" +} {1 {bad index "-09": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} # Indices relative to end @@ -336,20 +336,20 @@ test lindex-12.5 {index = end-3} { test lindex-12.6 {bad octal} { set x end-08 list [catch { lindex {a b c} $x } result] $result -} "1 {bad index \"end-08\": must be integer or end?-integer? (looks like invalid octal number)}" +} {1 {bad index "end-08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test lindex-12.7 {bad octal} { set x end--09 list [catch { lindex {a b c} $x } result] $result -} "1 {bad index \"end--09\": must be integer or end?-integer?}" +} {1 {bad index "end--09": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-12.8 {bad integer, not octal} { set x end-0a2 list [catch { lindex {a b c} $x } result] $result -} "1 {bad index \"end-0a2\": must be integer or end?-integer?}" +} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}} -test lindex-12.9 {incomplete end} { - set x en +test lindex-12.9 {obsolete test} { + set x end catch { list [lindex {a b c} $x] [lindex {a b c} $x] } result @@ -359,11 +359,11 @@ test lindex-12.9 {incomplete end} { test lindex-12.10 {incomplete end-} { set x end- list [catch { lindex {a b c} $x } result] $result -} "1 {bad index \"end-\": must be integer or end?-integer?}" +} {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-13.1 {bad second index} { list [catch { lindex {a b c} 0 0a2 } result] $result -} "1 {bad index \"0a2\": must be integer or end?-integer?}" +} {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}} test lindex-13.2 {good second index} { catch { diff --git a/tests/linsert.test b/tests/linsert.test index b3dcb6b..be8ae3d 100644 --- a/tests/linsert.test +++ b/tests/linsert.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: linsert.test,v 1.8 2000/04/10 17:19:01 ericm Exp $ +# RCS: @(#) $Id: linsert.test,v 1.9 2005/04/29 20:49:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -90,7 +90,7 @@ test linsert-2.2 {linsert errors} { } {1 {wrong # args: should be "linsert list index element ?element ...?"}} test linsert-2.3 {linsert errors} { list [catch {linsert a 12x 2} msg] $msg -} {1 {bad index "12x": must be integer or end?-integer?}} +} {1 {bad index "12x": must be integer?[+-]integer? or end?[+-]integer?}} test linsert-2.4 {linsert errors} { list [catch {linsert \{ 12 2} msg] $msg } {1 {unmatched open brace in list}} diff --git a/tests/lrange.test b/tests/lrange.test index 68e5d5e..aaaf81e 100644 --- a/tests/lrange.test +++ b/tests/lrange.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: lrange.test,v 1.7 2000/04/10 17:19:01 ericm Exp $ +# RCS: @(#) $Id: lrange.test,v 1.8 2005/04/29 20:49:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -43,7 +43,7 @@ test lrange-1.8 {range of list elements} { lrange {a b c d e} -2 -1 } {} test lrange-1.9 {range of list elements} { - lrange {a b c d e} -2 e + lrange {a b c d e} -2 end } {a b c d e} test lrange-1.10 {range of list elements} { lrange "a b\{c d" 1 2 @@ -55,7 +55,7 @@ test lrange-1.12 {range of list elements} { lrange "a b c d" end 100000 } d test lrange-1.13 {range of list elements} { - lrange "a b c d" e 3 + lrange "a b c d" end 3 } d test lrange-1.14 {range of list elements} { lrange "a b c d" end 2 @@ -75,10 +75,10 @@ test lrange-2.2 {error conditions} { } {1 {wrong # args: should be "lrange list first last"}} test lrange-2.3 {error conditions} { list [catch {lrange a b 6} msg] $msg -} {1 {bad index "b": must be integer or end?-integer?}} +} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} test lrange-2.4 {error conditions} { list [catch {lrange a 0 enigma} msg] $msg -} {1 {bad index "enigma": must be integer or end?-integer?}} +} {1 {bad index "enigma": must be integer?[+-]integer? or end?[+-]integer?}} test lrange-2.5 {error conditions} { list [catch {lrange "a \{b c" 3 4} msg] $msg } {1 {unmatched open brace in list}} diff --git a/tests/lreplace.test b/tests/lreplace.test index d3ca611..99b236e 100644 --- a/tests/lreplace.test +++ b/tests/lreplace.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: lreplace.test,v 1.7 2000/04/10 17:19:01 ericm Exp $ +# RCS: @(#) $Id: lreplace.test,v 1.8 2005/04/29 20:49:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -110,13 +110,13 @@ test lreplace-2.2 {lreplace errors} { } {1 {wrong # args: should be "lreplace list first last ?element element ...?"}} test lreplace-2.3 {lreplace errors} { list [catch {lreplace x a 10} msg] $msg -} {1 {bad index "a": must be integer or end?-integer?}} +} {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}} test lreplace-2.4 {lreplace errors} { list [catch {lreplace x 10 x} msg] $msg -} {1 {bad index "x": must be integer or end?-integer?}} +} {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}} test lreplace-2.5 {lreplace errors} { list [catch {lreplace x 10 1x} msg] $msg -} {1 {bad index "1x": must be integer or end?-integer?}} +} {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}} test lreplace-2.6 {lreplace errors} { list [catch {lreplace x 3 2} msg] $msg } {1 {list doesn't contain element 3}} diff --git a/tests/lsearch.test b/tests/lsearch.test index aded40b..d509407 100644 --- a/tests/lsearch.test +++ b/tests/lsearch.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: lsearch.test,v 1.13 2003/10/15 13:15:45 dkf Exp $ +# RCS: @(#) $Id: lsearch.test,v 1.14 2005/04/29 20:49:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -284,7 +284,7 @@ test lsearch-10.3 {offset searching} { } 3 test lsearch-10.4 {offset searching} { list [catch {lsearch -start foobar {a b c a b c} a} msg] $msg -} {1 {bad index "foobar": must be integer or end?-integer?}} +} {1 {bad index "foobar": must be integer?[+-]integer? or end?[+-]integer?}} test lsearch-10.5 {offset searching} { list [catch {lsearch -start 1 2} msg] $msg } {1 {missing starting index}} @@ -415,7 +415,7 @@ test lsearch-20.1 {lsearch -index option, index larger than sublists} { } {1 {element 2 missing from sublist "a c"}} test lsearch-20.2 {lsearch -index option, malformed index} { list [catch {lsearch -index foo {{a c} {a b} {a a}} a} msg] $msg -} {1 {bad index "foo": must be integer or end?-integer?}} +} {1 {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}} test lsearch-20.3 {lsearch -index option, malformed index} { list [catch {lsearch -index \{ {{a c} {a b} {a a}} a} msg] $msg } {1 {unmatched open brace in list}} diff --git a/tests/lset.test b/tests/lset.test index 048e9ba..00facb2 100644 --- a/tests/lset.test +++ b/tests/lset.test @@ -51,7 +51,7 @@ test lset-2.2 {lset, not compiled, 3 args, second arg neither index nor list} te list [catch { testevalex {lset x {{bad}1} 3} } msg] $msg -} "1 {bad index \"{bad}1\": must be integer or end?-integer?}" +} {1 {bad index "{bad}1": must be integer?[+-]integer? or end?[+-]integer?}} test lset-3.1 {lset, not compiled, 3 args, data duplicated} testevalex { set x {0 1 2} @@ -99,7 +99,7 @@ test lset-4.2 {lset, not compiled, 3 args, bad index} testevalex { list [catch { testevalex {lset a [list 2a2] w} } msg] $msg -} {1 {bad index "2a2": must be integer or end?-integer?}} +} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} test lset-4.3 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} @@ -141,7 +141,7 @@ test lset-4.8 {lset, not compiled, 3 args, bad index} testevalex { list [catch { testevalex {lset a 2a2 w} } msg] $msg -} {1 {bad index "2a2": must be integer or end?-integer?}} +} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} test lset-4.9 {lset, not compiled, 3 args, index out of range} testevalex { set a {x y z} @@ -300,12 +300,12 @@ test lset-8.2 {lset, not compiled, malformed sublist} testevalex { test lset-8.3 {lset, not compiled, bad second index} testevalex { set a {{b c} {d e}} list [catch {testevalex {lset a 0 2a2 f}} msg] $msg -} {1 {bad index "2a2": must be integer or end?-integer?}} +} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} test lset-8.4 {lset, not compiled, bad second index} testevalex { set a {{b c} {d e}} list [catch {testevalex {lset a {0 2a2} f}} msg] $msg -} {1 {bad index "2a2": must be integer or end?-integer?}} +} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} test lset-8.5 {lset, not compiled, second index out of range} testevalex { set a {{b c} {d e} {f g}} diff --git a/tests/regexp.test b/tests/regexp.test index fe4221b..f190298 100644 --- a/tests/regexp.test +++ b/tests/regexp.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: regexp.test,v 1.25 2003/10/14 18:23:31 vincentdarley Exp $ +# RCS: @(#) $Id: regexp.test,v 1.26 2005/04/29 20:49:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -220,7 +220,7 @@ test regexp-6.8 {regexp errors} { } {1 {couldn't set variable "f1(f2)"}} test regexp-6.9 {regexp errors, -start bad int check} { list [catch {regexp -start bogus {^$} {}} msg] $msg -} {1 {expected integer but got "bogus"}} +} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} test regexp-7.1 {basic regsub operation} { list [regsub aa+ xaxaaaxaa 111&222 foo] $foo @@ -377,7 +377,7 @@ test regexp-11.7 {regsub errors} { } {1 {couldn't set variable "f1(f2)"}} test regexp-11.8 {regsub errors, -start bad int check} { list [catch {regsub -start bogus pattern string rep var} msg] $msg -} {1 {expected integer but got "bogus"}} +} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} test regexp-11.9 {regsub without final variable name returns value} { regsub b abaca X } {aXaca} @@ -467,6 +467,20 @@ test regexp-15.5 {regexp -start, over end of string} { test regexp-15.6 {regexp -start, loss of ^$ behavior} { list [regexp -start 2 {^$} {}] } {0} +test regexp-15.7 {regexp -start, double option} { + regexp -start 2 -start 0 a abc +} 1 +test regexp-15.8 {regexp -start, double option} { + regexp -start 0 -start 2 a abc +} 0 +test regexp-15.9 {regexp -start, end relative index} { + catch {unset x} + list [regexp -start end {\d} 1abc2de3 x] [info exists x] +} {0 0} +test regexp-15.10 {regexp -start, end relative index} { + catch {unset x} + list [regexp -start end-1 {\d} 1abc2de3 x] [info exists x] $x +} {1 1 3} test regexp-16.1 {regsub -start} { catch {unset x} @@ -485,6 +499,18 @@ test regexp-16.4 {regsub -start, \A behavior} { lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x } {5 /a/b/c/d/e 3 ab/c/d/e} +test regexp-16.5 {regsub -start, double option} { + list [regsub -start 2 -start 0 a abc c x] $x +} {1 cbc} +test regexp-16.6 {regsub -start, double option} { + list [regsub -start 0 -start 2 a abc c x] $x +} {0 abc} +test regexp-16.7 {regexp -start, end relative index} { + list [regsub -start end a aaa b x] $x +} {0 aaa} +test regexp-16.8 {regexp -start, end relative index} { + list [regsub -start end-1 a aaa b x] $x +} {1 aab} test regexp-17.1 {regexp -inline} { regexp -inline b ababa diff --git a/tests/regexpComp.test b/tests/regexpComp.test index 6580d60..a84099e 100644 --- a/tests/regexpComp.test +++ b/tests/regexpComp.test @@ -301,7 +301,7 @@ test regexpComp-6.9 {regexp errors, -start bad int check} { evalInProc { list [catch {regexp -start bogus {^$} {}} msg] $msg } -} {1 {expected integer but got "bogus"}} +} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} test regexpComp-7.1 {basic regsub operation} { evalInProc { @@ -542,7 +542,7 @@ test regexpComp-11.8 {regsub errors, -start bad int check} { evalInProc { list [catch {regsub -start bogus pattern string rep var} msg] $msg } -} {1 {expected integer but got "bogus"}} +} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} # This test crashes on the Mac unless you increase the Stack Space to about 1 # Meg. This is probably bigger than most users want... diff --git a/tests/string.test b/tests/string.test index 45bb587..c7a9f51 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.45 2005/04/22 16:26:04 dgp Exp $ +# RCS: @(#) $Id: string.test,v 1.46 2005/04/29 20:49:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -176,7 +176,7 @@ test string-4.1 {string first, too few args} { } {1 {wrong # args: should be "string first subString string ?startIndex?"}} test string-4.2 {string first, bad args} { list [catch {string first a b c} msg] $msg -} {1 {bad index "c": must be integer or end?-integer?}} +} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}} test string-4.3 {string first, too many args} { list [catch {string first a b 5 d} msg] $msg } {1 {wrong # args: should be "string first subString string ?startIndex?"}} @@ -241,7 +241,7 @@ test string-5.6 {string index} { } {0 {}} test string-5.7 {string index} { list [catch {string index a xyz} msg] $msg -} {1 {bad index "xyz": must be integer or end?-integer?}} +} {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}} test string-5.8 {string index} { string index abc end } c @@ -276,10 +276,10 @@ test string-5.16 {string index, bytearray object with string obj shimmering} { } 0 test string-5.17 {string index, bad integer} { list [catch {string index "abc" 08} msg] $msg -} {1 {bad index "08": must be integer or end?-integer? (looks like invalid octal number)}} +} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test string-5.18 {string index, bad integer} { list [catch {string index "abc" end-00289} msg] $msg -} {1 {bad index "end-00289": must be integer or end?-integer? (looks like invalid octal number)}} +} {1 {bad index "end-00289": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test string-5.19 {string index, bytearray object out of bounds} { string index [binary format I* {0x50515253 0x52}] -1 } {} @@ -667,7 +667,7 @@ test string-7.1 {string last, too few args} { } {1 {wrong # args: should be "string last subString string ?startIndex?"}} test string-7.2 {string last, bad args} { list [catch {string last a b c} msg] $msg -} {1 {bad index "c": must be integer or end?-integer?}} +} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}} test string-7.3 {string last, too many args} { list [catch {string last a b c d} msg] $msg } {1 {wrong # args: should be "string last subString string ?startIndex?"}} @@ -1022,7 +1022,7 @@ test string-12.5 {string range, last > length} { string range abcdefghijklmnop 7 1000 } {hijklmnop} test string-12.6 {string range} { - string range abcdefghijklmnop 10 e + string range abcdefghijklmnop 10 end } {klmnop} test string-12.7 {string range, last < first} { string range abcdefghijklmnop 10 9 @@ -1041,15 +1041,15 @@ test string-12.11 {string range} { } {abcdefghijklmnop} test string-12.12 {string range} { list [catch {string range abc abc 1} msg] $msg -} {1 {bad index "abc": must be integer or end?-integer?}} +} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}} test string-12.13 {string range} { list [catch {string range abc 1 eof} msg] $msg -} {1 {bad index "eof": must be integer or end?-integer?}} +} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}} test string-12.14 {string range} { string range abcdefghijklmnop end-1 end } {op} test string-12.15 {string range} { - string range abcdefghijklmnop e 1000 + string range abcdefghijklmnop end 1000 } {p} test string-12.16 {string range} { string range abcdefghijklmnop end end-1 @@ -1132,7 +1132,7 @@ test string-14.6 {string replace} { string replace abcdefghijklmnop 7 1000 } {abcdefg} test string-14.7 {string replace} { - string replace abcdefghijklmnop 10 e + string replace abcdefghijklmnop 10 end } {abcdefghij} test string-14.8 {string replace} { string replace abcdefghijklmnop 10 9 @@ -1151,15 +1151,15 @@ test string-14.12 {string replace} { } {} test string-14.13 {string replace} { list [catch {string replace abc abc 1} msg] $msg -} {1 {bad index "abc": must be integer or end?-integer?}} +} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}} test string-14.14 {string replace} { list [catch {string replace abc 1 eof} msg] $msg -} {1 {bad index "eof": must be integer or end?-integer?}} +} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}} test string-14.15 {string replace} { string replace abcdefghijklmnop end-10 end-2 NEW } {abcdeNEWop} test string-14.16 {string replace} { - string replace abcdefghijklmnop 0 e foo + string replace abcdefghijklmnop 0 end foo } {foo} test string-14.17 {string replace} { string replace abcdefghijklmnop end end-1 @@ -1170,7 +1170,7 @@ test string-15.1 {string tolower too few args} { } {1 {wrong # args: should be "string tolower string ?first? ?last?"}} test string-15.2 {string tolower bad args} { list [catch {string tolower a b} msg] $msg -} {1 {bad index "b": must be integer or end?-integer?}} +} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} test string-15.3 {string tolower too many args} { list [catch {string tolower ABC 1 end oops} msg] $msg } {1 {wrong # args: should be "string tolower string ?first? ?last?"}} @@ -1201,7 +1201,7 @@ test string-16.1 {string toupper} { } {1 {wrong # args: should be "string toupper string ?first? ?last?"}} test string-16.2 {string toupper} { list [catch {string toupper a b} msg] $msg -} {1 {bad index "b": must be integer or end?-integer?}} +} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} test string-16.3 {string toupper} { list [catch {string toupper a 1 end oops} msg] $msg } {1 {wrong # args: should be "string toupper string ?first? ?last?"}} @@ -1232,7 +1232,7 @@ test string-17.1 {string totitle} { } {1 {wrong # args: should be "string totitle string ?first? ?last?"}} test string-17.2 {string totitle} { list [catch {string totitle a b} msg] $msg -} {1 {bad index "b": must be integer or end?-integer?}} +} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} test string-17.3 {string totitle} { string totitle abCDEf } {Abcdef} @@ -1314,7 +1314,7 @@ test string-21.2 {string wordend} { } {1 {wrong # args: should be "string wordend string index"}} test string-21.3 {string wordend} { list [catch {string wordend a gorp} msg] $msg -} {1 {bad index "gorp": must be integer or end?-integer?}} +} {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}} test string-21.4 {string wordend} { string wordend abc. -1 } 3 @@ -1360,7 +1360,7 @@ test string-22.3 {string wordstart} { } {1 {wrong # args: should be "string wordstart string index"}} test string-22.4 {string wordstart} { list [catch {string wordstart a gorp} msg] $msg -} {1 {bad index "gorp": must be integer or end?-integer?}} +} {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}} test string-22.5 {string wordstart} { string wordstart "one two three_words" 400 } 8 diff --git a/tests/stringComp.test b/tests/stringComp.test index e2cd121..6af2be4 100644 --- a/tests/stringComp.test +++ b/tests/stringComp.test @@ -15,7 +15,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: stringComp.test,v 1.8 2004/05/25 18:58:05 dgp Exp $ +# RCS: @(#) $Id: stringComp.test,v 1.9 2005/04/29 20:49:44 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -226,7 +226,7 @@ test stringComp-4.1 {string first, too few args} { test stringComp-4.2 {string first, bad args} { proc foo {} {string first a b c} list [catch {foo} msg] $msg -} {1 {bad index "c": must be integer or end?-integer?}} +} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}} test stringComp-4.3 {string first, too many args} { proc foo {} {string first a b 5 d} list [catch {foo} msg] $msg @@ -303,7 +303,7 @@ test stringComp-5.6 {string index} { test stringComp-5.7 {string index} { proc foo {} {string index a xyz} list [catch {foo} msg] $msg -} {1 {bad index "xyz": must be integer or end?-integer?}} +} {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}} test stringComp-5.8 {string index} { proc foo {} {string index abc end} foo @@ -352,11 +352,11 @@ test stringComp-5.16 {string index, bytearray object with string obj shimmering} test stringComp-5.17 {string index, bad integer} { proc foo {} {string index "abc" 08} list [catch {foo} msg] $msg -} {1 {bad index "08": must be integer or end?-integer? (looks like invalid octal number)}} +} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test stringComp-5.18 {string index, bad integer} { proc foo {} {string index "abc" end-00289} list [catch {foo} msg] $msg -} {1 {bad index "end-00289": must be integer or end?-integer? (looks like invalid octal number)}} +} {1 {bad index "end-00289": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}} test stringComp-5.19 {string index, bytearray object out of bounds} { proc foo {} {string index [binary format I* {0x50515253 0x52}] -1} foo diff --git a/tests/util.test b/tests/util.test index ae3d0c5..e097efa 100644 --- a/tests/util.test +++ b/tests/util.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: util.test,v 1.14 2004/05/19 20:15:32 dkf Exp $ +# RCS: @(#) $Id: util.test,v 1.15 2005/04/29 20:49:45 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -388,6 +388,190 @@ test util-8.6 {TclNeedSpace - correct UTF8 handling} testdstring { list [llength [testdstring get]] [string length [testdstring get]] } {2 9} +test util-9.0.0 {TclGetIntForIndex} { + string index abcd 0 +} a +test util-9.0.1 {TclGetIntForIndex} { + string index abcd 0x0 +} a +test util-9.0.2 {TclGetIntForIndex} { + string index abcd -0x0 +} a +test util-9.0.3 {TclGetIntForIndex} { + string index abcd { 0 } +} a +test util-9.0.4 {TclGetIntForIndex} { + string index abcd { 0x0 } +} a +test util-9.0.5 {TclGetIntForIndex} { + string index abcd { -0x0 } +} a +test util-9.0.6 {TclGetIntForIndex} { + string index abcd 01 +} b +test util-9.0.7 {TclGetIntForIndex} { + string index abcd { 01 } +} b +test util-9.1.0 {TclGetIntForIndex} { + string index abcd 3 +} d +test util-9.1.1 {TclGetIntForIndex} { + string index abcd { 3 } +} d +test util-9.1.2 {TclGetIntForIndex} { + string index abcdefghijk 0xa +} k +test util-9.1.3 {TclGetIntForIndex} { + string index abcdefghijk { 0xa } +} k +test util-9.2.0 {TclGetIntForIndex} { + string index abcd end +} d +test util-9.2.1 {TclGetIntForIndex} -body { + string index abcd { end} +} -returnCodes error -match glob -result * +test util-9.2.2 {TclGetIntForIndex} -body { + string index abcd {end } +} -returnCodes error -match glob -result * +test util-9.3 {TclGetIntForIndex} { + # Deprecated + string index abcd en +} d +test util-9.4 {TclGetIntForIndex} { + # Deprecated + string index abcd e +} d +test util-9.5.0 {TclGetIntForIndex} { + string index abcd end-1 +} c +test util-9.5.1 {TclGetIntForIndex} { + string index abcd {end-1 } +} c +test util-9.5.2 {TclGetIntForIndex} -body { + string index abcd { end-1} +} -returnCodes error -match glob -result * +test util-9.6 {TclGetIntForIndex} { + string index abcd end+-1 +} c +test util-9.7 {TclGetIntForIndex} { + string index abcd end+1 +} {} +test util-9.8 {TclGetIntForIndex} { + string index abcd end--1 +} {} +test util-9.9.0 {TclGetIntForIndex} { + string index abcd 0+0 +} a +test util-9.9.1 {TclGetIntForIndex} { + string index abcd { 0+0 } +} a +test util-9.10 {TclGetIntForIndex} { + string index abcd 0-0 +} a +test util-9.11 {TclGetIntForIndex} { + string index abcd 1+0 +} b +test util-9.12 {TclGetIntForIndex} { + string index abcd 1-0 +} b +test util-9.13 {TclGetIntForIndex} { + string index abcd 1+1 +} c +test util-9.14 {TclGetIntForIndex} { + string index abcd 1-1 +} a +test util-9.15 {TclGetIntForIndex} { + string index abcd -1+2 +} b +test util-9.16 {TclGetIntForIndex} { + string index abcd -1--2 +} b +test util-9.17 {TclGetIntForIndex} { + string index abcd { -1+2 } +} b +test util-9.18 {TclGetIntForIndex} { + string index abcd { -1--2 } +} b +test util-9.19 {TclGetIntForIndex} -body { + string index a {} +} -returnCodes error -match glob -result * +test util-9.20 {TclGetIntForIndex} -body { + string index a { } +} -returnCodes error -match glob -result * +test util-9.21 {TclGetIntForIndex} -body { + string index a " \r\t\n" +} -returnCodes error -match glob -result * +test util-9.22 {TclGetIntForIndex} -body { + string index a + +} -returnCodes error -match glob -result * +test util-9.23 {TclGetIntForIndex} -body { + string index a - +} -returnCodes error -match glob -result * +test util-9.24 {TclGetIntForIndex} -body { + string index a x +} -returnCodes error -match glob -result * +test util-9.25 {TclGetIntForIndex} -body { + string index a +x +} -returnCodes error -match glob -result * +test util-9.26 {TclGetIntForIndex} -body { + string index a -x +} -returnCodes error -match glob -result * +test util-9.27 {TclGetIntForIndex} -body { + string index a 0y +} -returnCodes error -match glob -result * +test util-9.28 {TclGetIntForIndex} -body { + string index a 1* +} -returnCodes error -match glob -result * +test util-9.29 {TclGetIntForIndex} -body { + string index a 0+ +} -returnCodes error -match glob -result * +test util-9.30 {TclGetIntForIndex} -body { + string index a {0+ } +} -returnCodes error -match glob -result * +test util-9.31 {TclGetIntForIndex} -body { + string index a 0x +} -returnCodes error -match glob -result * +test util-9.32 {TclGetIntForIndex} -body { + string index a 0x1FFFFFFFF+0 +} -returnCodes error -match glob -result * +test util-9.33 {TclGetIntForIndex} -body { + string index a 100000000000+0 +} -returnCodes error -match glob -result * +test util-9.34 {TclGetIntForIndex} -body { + string index a 1.0 +} -returnCodes error -match glob -result * +test util-9.35 {TclGetIntForIndex} -body { + string index a 1e23 +} -returnCodes error -match glob -result * +test util-9.36 {TclGetIntForIndex} -body { + string index a 1.5e2 +} -returnCodes error -match glob -result * +test util-9.37 {TclGetIntForIndex} -body { + string index a 0+x +} -returnCodes error -match glob -result * +test util-9.38 {TclGetIntForIndex} -body { + string index a 0+0x +} -returnCodes error -match glob -result * +test util-9.39 {TclGetIntForIndex} -body { + string index a 0+0xg +} -returnCodes error -match glob -result * +test util-9.40 {TclGetIntForIndex} -body { + string index a 0+0xg +} -returnCodes error -match glob -result * +test util-9.41 {TclGetIntForIndex} -body { + string index a 0+1.0 +} -returnCodes error -match glob -result * +test util-9.42 {TclGetIntForIndex} -body { + string index a 0+1e2 +} -returnCodes error -match glob -result * +test util-9.43 {TclGetIntForIndex} -body { + string index a 0+1.5e1 +} -returnCodes error -match glob -result * +test util-9.44 {TclGetIntForIndex} -body { + string index a 0+1000000000000 +} -returnCodes error -match glob -result * + + # cleanup ::tcltest::cleanupTests return |