summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/cmdIL.test4
-rw-r--r--tests/compile.test8
-rw-r--r--tests/lindex.test42
-rw-r--r--tests/linsert.test4
-rw-r--r--tests/lrange.test10
-rw-r--r--tests/lreplace.test8
-rw-r--r--tests/lsearch.test6
-rw-r--r--tests/lset.test10
-rw-r--r--tests/regexp.test32
-rw-r--r--tests/regexpComp.test4
-rw-r--r--tests/string.test38
-rw-r--r--tests/stringComp.test10
-rw-r--r--tests/util.test186
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