summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/foreach.test36
-rw-r--r--tests/format.test24
-rw-r--r--tests/if-old.test22
-rw-r--r--tests/incr-old.test16
-rw-r--r--tests/info.test10
-rw-r--r--tests/list.test57
-rw-r--r--tests/lsearch.test22
-rw-r--r--tests/trace.test25
-rw-r--r--tests/utf.test19
9 files changed, 82 insertions, 149 deletions
diff --git a/tests/foreach.test b/tests/foreach.test
index fa5b3ea..0ab6340 100644
--- a/tests/foreach.test
+++ b/tests/foreach.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: foreach.test,v 1.8 2001/09/19 18:17:54 hobbs Exp $
+# RCS: @(#) $Id: foreach.test,v 1.8.8.1 2003/03/27 13:11:01 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -171,8 +171,8 @@ test foreach-4.1 {noncompiled foreach and shared variable or value list objects
# Check "continue".
-test foreach-4.1 {continue tests} {catch continue} 4
-test foreach-4.2 {continue tests} {
+test foreach-5.1 {continue tests} {catch continue} 4
+test foreach-5.2 {continue tests} {
set a {}
foreach i {a b c d} {
if {[string compare $i "b"] == 0} continue
@@ -180,7 +180,7 @@ test foreach-4.2 {continue tests} {
}
set a
} {a c d}
-test foreach-4.3 {continue tests} {
+test foreach-5.3 {continue tests} {
set a {}
foreach i {a b c d} {
if {[string compare $i "b"] != 0} continue
@@ -188,16 +188,16 @@ test foreach-4.3 {continue tests} {
}
set a
} {b}
-test foreach-4.4 {continue tests} {catch {continue foo} msg} 1
-test foreach-4.5 {continue tests} {
+test foreach-5.4 {continue tests} {catch {continue foo} msg} 1
+test foreach-5.5 {continue tests} {
catch {continue foo} msg
set msg
} {wrong # args: should be "continue"}
# Check "break".
-test foreach-5.1 {break tests} {catch break} 3
-test foreach-5.2 {break tests} {
+test foreach-6.1 {break tests} {catch break} 3
+test foreach-6.2 {break tests} {
set a {}
foreach i {a b c d} {
if {[string compare $i "c"] == 0} break
@@ -205,13 +205,13 @@ test foreach-5.2 {break tests} {
}
set a
} {a b}
-test foreach-5.3 {break tests} {catch {break foo} msg} 1
-test foreach-5.4 {break tests} {
+test foreach-6.3 {break tests} {catch {break foo} msg} 1
+test foreach-6.4 {break tests} {
catch {break foo} msg
set msg
} {wrong # args: should be "break"}
# Check for bug #406709
-test foreach-5.5 {break tests} {
+test foreach-6.5 {break tests} {
proc a {} {
set a 1
foreach b b {list [concat a; break]; incr a}
@@ -222,7 +222,7 @@ test foreach-5.5 {break tests} {
# Test for incorrect "double evaluation" semantics
-test foreach-6.1 {delayed substitution of body} {
+test foreach-7.1 {delayed substitution of body} {
proc foo {} {
set a 0
foreach a [list 1 2 3] "
@@ -238,15 +238,3 @@ catch {unset a}
catch {unset x}
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/format.test b/tests/format.test
index 423c476..909c993 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.11.2.2 2003/03/14 23:19:45 dkf Exp $
+# RCS: @(#) $Id: format.test,v 1.11.2.3 2003/03/27 13:11:11 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -84,37 +84,37 @@ test format-2.5 {string formatting, embedded nulls} {
test format-2.6 {string formatting, international chars} {
format "%10s" abc\ufeffdef
} " abc\ufeffdef"
-test format-2.6 {string formatting, international chars} {
+test format-2.7 {string formatting, international chars} {
format "%.5s" abc\ufeffdef
} "abc\ufeffd"
-test format-2.7 {string formatting, international chars} {
+test format-2.8 {string formatting, international chars} {
format "foo\ufeffbar%s" baz
} "foo\ufeffbarbaz"
-test format-2.8 {string formatting, width} {
+test format-2.9 {string formatting, width} {
format "a%5sa" f
} "a fa"
-test format-2.8 {string formatting, width} {
+test format-2.10 {string formatting, width} {
format "a%-5sa" f
} "af a"
-test format-2.8 {string formatting, width} {
+test format-2.11 {string formatting, width} {
format "a%2sa" foo
} "afooa"
-test format-2.8 {string formatting, width} {
+test format-2.12 {string formatting, width} {
format "a%0sa" foo
} "afooa"
-test format-2.8 {string formatting, precision} {
+test format-2.13 {string formatting, precision} {
format "a%.2sa" foobarbaz
} "afoa"
-test format-2.8 {string formatting, precision} {
+test format-2.14 {string formatting, precision} {
format "a%.sa" foobarbaz
} "aa"
-test format-2.8 {string formatting, precision} {
+test format-2.15 {string formatting, precision} {
list [catch {format "a%.-2sa" foobarbaz} msg] $msg
} {1 {bad field specifier "-"}}
-test format-2.8 {string formatting, width and precision} {
+test format-2.16 {string formatting, width and precision} {
format "a%5.2sa" foobarbaz
} "a foa"
-test format-2.8 {string formatting, width and precision} {
+test format-2.17 {string formatting, width and precision} {
format "a%5.7sa" foobarbaz
} "afoobarba"
diff --git a/tests/if-old.test b/tests/if-old.test
index f0b977b..8c85f0a 100644
--- a/tests/if-old.test
+++ b/tests/if-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: if-old.test,v 1.5 2000/04/10 17:18:59 ericm Exp $
+# RCS: @(#) $Id: if-old.test,v 1.5.24.1 2003/03/27 13:11:12 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -45,22 +45,22 @@ test if-old-1.5 {taking proper branch} {
if 0 {set a 1} else {}
set a
} {}
-test if-old-1.5 {taking proper branch} {
+test if-old-1.6 {taking proper branch} {
set a {}
if 0 {set a 1} elseif 1 {set a 2} elseif 1 {set a 3} else {set a 4}
set a
} {2}
-test if-old-1.6 {taking proper branch} {
+test if-old-1.7 {taking proper branch} {
set a {}
if 0 {set a 1} elseif 0 {set a 2} elseif 1 {set a 3} else {set a 4}
set a
} {3}
-test if-old-1.7 {taking proper branch} {
+test if-old-1.8 {taking proper branch} {
set a {}
if 0 {set a 1} elseif 0 {set a 2} elseif 0 {set a 3} else {set a 4}
set a
} {4}
-test if-old-1.8 {taking proper branch, multiline test expr} {
+test if-old-1.9 {taking proper branch, multiline test expr} {
set a {}
if {($tcl_platform(platform) != "foobar1") && \
($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4}
@@ -162,15 +162,3 @@ test if-old-4.11 {error conditions} {
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/incr-old.test b/tests/incr-old.test
index 1c78b82..566eafd 100644
--- a/tests/incr-old.test
+++ b/tests/incr-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: incr-old.test,v 1.6 2003/02/06 22:44:58 mdejong Exp $
+# RCS: @(#) $Id: incr-old.test,v 1.6.2.1 2003/03/27 13:11:13 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -34,7 +34,7 @@ test incr-old-1.3 {basic incr operation} {
set x " -106"
list [incr x 1] $x
} {-105 -105}
-test incr-old-1.3 {basic incr operation} {
+test incr-old-1.4 {basic incr operation} {
set x " +106"
list [incr x 1] $x
} {107 107}
@@ -94,15 +94,3 @@ test incr-old-2.10 {incr errors} {
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/info.test b/tests/info.test
index 4f87e99..715f9ae 100644
--- a/tests/info.test
+++ b/tests/info.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: info.test,v 1.24 2002/07/01 07:52:03 dgp Exp $
+# RCS: @(#) $Id: info.test,v 1.24.2.1 2003/03/27 13:11:14 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -162,16 +162,16 @@ test info-5.1 {info complete option} {
test info-5.2 {info complete option} {
info complete abc
} 1
-test info-5.2 {info complete option} {
+test info-5.3 {info complete option} {
info complete "\{abcd "
} 0
-test info-5.3 {info complete option} {
+test info-5.4 {info complete option} {
info complete {# Comment should be complete command}
} 1
-test info-5.4 {info complete option} {
+test info-5.5 {info complete option} {
info complete {[a [b] }
} 0
-test info-5.5 {info complete option} {
+test info-5.6 {info complete option} {
info complete {[a [b]}
} 0
diff --git a/tests/list.test b/tests/list.test
index e20023e..da61f10 100644
--- a/tests/list.test
+++ b/tests/list.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: list.test,v 1.5 2000/04/10 17:19:01 ericm Exp $
+# RCS: @(#) $Id: list.test,v 1.5.24.1 2003/03/27 13:11:15 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -48,33 +48,28 @@ test list-1.24 {basic tests} {list} {}
# For the next round of tests create a list and then pick it apart
# with "index" to make sure that we get back exactly what went in.
-test list-2.1 {placeholder} {
-} {}
-set num 1
-proc lcheck {a b c} {
+set num 0
+proc lcheck {testid a b c} {
global num d
set d [list $a $b $c]
-; test list-2.$num {what goes in must come out} {lindex $d 0} $a
- set num [expr $num+1]
-; test list-2.$num {what goes in must come out} {lindex $d 1} $b
- set num [expr $num+1]
-; test list-2.$num {what goes in must come out} {lindex $d 2} $c
- set num [expr $num+1]
+ test ${testid}-0 {what goes in must come out} {lindex $d 0} $a
+ test ${testid}-1 {what goes in must come out} {lindex $d 1} $b
+ test ${testid}-2 {what goes in must come out} {lindex $d 2} $c
}
-lcheck a b c
-lcheck "a b" c\td e\nf
-lcheck {{a b}} {} { }
-lcheck \$ \$ab ab\$
-lcheck \; \;ab ab\;
-lcheck \[ \[ab ab\[
-lcheck \\ \\ab ab\\
-lcheck {"} {"ab} {ab"}
-lcheck {a b} { ab} {ab }
-lcheck a{ a{b \{ab
-lcheck a} a}b }ab
-lcheck a\\} {a \}b} {a \{c}
-lcheck xyz \\ 1\\\n2
-lcheck "{ab}\\" "{ab}xy" abc
+lcheck list-2.1 a b c
+lcheck list-2.2 "a b" c\td e\nf
+lcheck list-2.3 {{a b}} {} { }
+lcheck list-2.4 \$ \$ab ab\$
+lcheck list-2.5 \; \;ab ab\;
+lcheck list-2.6 \[ \[ab ab\[
+lcheck list-2.7 \\ \\ab ab\\
+lcheck list-2.8 {"} {"ab} {ab"} ;#" Stupid emacs highlighting!
+lcheck list-2.9 {a b} { ab} {ab }
+lcheck list-2.10 a{ a{b \{ab
+lcheck list-2.11 a} a}b }ab
+lcheck list-2.12 a\\} {a \}b} {a \{c}
+lcheck list-2.13 xyz \\ 1\\\n2
+lcheck list-2.14 "{ab}\\" "{ab}xy" abc
concat {}
@@ -113,15 +108,3 @@ test list-3.1 {SetListFromAny and lrange/concat results} {
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/lsearch.test b/tests/lsearch.test
index 1beaaab..96ff415 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.10 2003/02/27 16:02:00 dkf Exp $
+# RCS: @(#) $Id: lsearch.test,v 1.10.2.1 2003/03/27 13:11:16 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -315,37 +315,37 @@ test lsearch-13.2 {search for all matches} {
lsearch -all {a b a c a d} a
} {0 2 4}
-test lsearch-13.1 {combinations: -all and -inline} {
+test lsearch-14.1 {combinations: -all and -inline} {
lsearch -all -inline -glob {a1 b2 a3 c4 a5 d6} a*
} {a1 a3 a5}
-test lsearch-13.2 {combinations: -all, -inline and -not} {
+test lsearch-14.2 {combinations: -all, -inline and -not} {
lsearch -all -inline -not -glob {a1 b2 a3 c4 a5 d6} a*
} {b2 c4 d6}
-test lsearch-13.3 {combinations: -all and -not} {
+test lsearch-14.3 {combinations: -all and -not} {
lsearch -all -not -glob {a1 b2 a3 c4 a5 d6} a*
} {1 3 5}
-test lsearch-13.4 {combinations: -inline and -not} {
+test lsearch-14.4 {combinations: -inline and -not} {
lsearch -inline -not -glob {a1 b2 a3 c4 a5 d6} a*
} {b2}
-test lsearch-13.5 {combinations: -start, -all and -inline} {
+test lsearch-14.5 {combinations: -start, -all and -inline} {
lsearch -start 2 -all -inline -glob {a1 b2 a3 c4 a5 d6} a*
} {a3 a5}
-test lsearch-13.6 {combinations: -start, -all, -inline and -not} {
+test lsearch-14.6 {combinations: -start, -all, -inline and -not} {
lsearch -start 2 -all -inline -not -glob {a1 b2 a3 c4 a5 d6} a*
} {c4 d6}
-test lsearch-13.7 {combinations: -start, -all and -not} {
+test lsearch-14.7 {combinations: -start, -all and -not} {
lsearch -start 2 -all -not -glob {a1 b2 a3 c4 a5 d6} a*
} {3 5}
-test lsearch-13.8 {combinations: -start, -inline and -not} {
+test lsearch-14.8 {combinations: -start, -inline and -not} {
lsearch -start 2 -inline -not -glob {a1 b2 a3 c4 a5 d6} a*
} {c4}
-test lsearch-14.1 {make sure no shimmering occurs} {
+test lsearch-15.1 {make sure no shimmering occurs} {
set x [expr int(sin(0))]
lsearch -start $x $x $x
} 0
-test lsearch-15.1 {lsearch -regexp shared object} {
+test lsearch-16.1 {lsearch -regexp shared object} {
set str a
lsearch -regexp $str $str
} 0
diff --git a/tests/trace.test b/tests/trace.test
index 2da4a9f..cedb7ba 100644
--- a/tests/trace.test
+++ b/tests/trace.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: trace.test,v 1.26 2003/02/03 20:16:54 kennykb Exp $
+# RCS: @(#) $Id: trace.test,v 1.26.2.1 2003/03/27 13:11:17 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -828,13 +828,13 @@ test trace-14.11 {trace command, "trace variable" errors} {
} [list 1 "bad operations \"y\": should be one or more of rwua"]
-test trace-14.9 {trace command ("remove variable" option)} {
+test trace-14.12 {trace command ("remove variable" option)} {
catch {unset x}
set info {}
trace add variable x write traceProc
trace remove variable x write traceProc
} {}
-test trace-14.10 {trace command ("remove variable" option)} {
+test trace-14.13 {trace command ("remove variable" option)} {
catch {unset x}
set info {}
trace add variable x write traceProc
@@ -842,7 +842,7 @@ test trace-14.10 {trace command ("remove variable" option)} {
set x 12345
set info
} {}
-test trace-14.11 {trace command ("remove variable" option)} {
+test trace-14.14 {trace command ("remove variable" option)} {
catch {unset x}
set info {}
trace add variable x write {traceTag 1}
@@ -857,7 +857,7 @@ test trace-14.11 {trace command ("remove variable" option)} {
set x gorp
set info
} {2 x {} write 1 2 1 2}
-test trace-14.12 {trace command ("remove variable" option)} {
+test trace-14.15 {trace command ("remove variable" option)} {
catch {unset x}
set info {}
trace add variable x write {traceTag 1}
@@ -865,27 +865,27 @@ test trace-14.12 {trace command ("remove variable" option)} {
set x 12345
set info
} {1}
-test trace-14.15 {trace command ("info variable" option)} {
+test trace-14.16 {trace command ("info variable" option)} {
catch {unset x}
trace add variable x write {traceTag 1}
trace add variable x write traceProc
trace add variable x write {traceTag 2}
trace info variable x
} {{write {traceTag 2}} {write traceProc} {write {traceTag 1}}}
-test trace-14.16 {trace command ("info variable" option)} {
+test trace-14.17 {trace command ("info variable" option)} {
catch {unset x}
trace info variable x
} {}
-test trace-14.17 {trace command ("info variable" option)} {
+test trace-14.18 {trace command ("info variable" option)} {
catch {unset x}
trace info variable x(0)
} {}
-test trace-14.18 {trace command ("info variable" option)} {
+test trace-14.19 {trace command ("info variable" option)} {
catch {unset x}
set x 44
trace info variable x(0)
} {}
-test trace-14.19 {trace command ("info variable" option)} {
+test trace-14.20 {trace command ("info variable" option)} {
catch {unset x}
set x 44
trace add variable x write {traceTag 1}
@@ -1165,12 +1165,12 @@ test trace-18.2 {namespace delete / trace vdelete combo} {
catch {unset x}
catch {unset y}
-test trace-18.2 {trace add command (command existence)} {
+test trace-18.3 {trace add command (command existence)} {
# Just in case!
catch {rename nosuchname ""}
list [catch {trace add command nosuchname rename traceCommand} msg] $msg
} {1 {unknown command "nosuchname"}}
-test trace-18.3 {trace add command (command existence in ns)} {
+test trace-18.4 {trace add command (command existence in ns)} {
list [catch {trace add command nosuchns::nosuchname rename traceCommand} msg] $msg
} {1 {unknown command "nosuchns::nosuchname"}}
@@ -2105,4 +2105,3 @@ catch {unset info}
# cleanup
::tcltest::cleanupTests
return
-
diff --git a/tests/utf.test b/tests/utf.test
index 9929482..56e1b5f 100644
--- a/tests/utf.test
+++ b/tests/utf.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: utf.test,v 1.8.14.1 2003/03/06 23:24:18 dgp Exp $
+# RCS: @(#) $Id: utf.test,v 1.8.14.2 2003/03/27 13:11:18 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -290,11 +290,11 @@ test utf-24.2 {unicode digit char in regc_locale.c} {
list [regexp {^[[:digit:]]+$} \u1040] [regexp {^\d+$} \u1040]
} {1 1}
-test utf-24.1 {TclUniCharIsSpace} {
+test utf-24.3 {TclUniCharIsSpace} {
# this returns 1 with Unicode 3 compliance
string is space \u1680
} {1}
-test utf-24.2 {unicode space char in regc_locale.c} {
+test utf-24.4 {unicode space char in regc_locale.c} {
# this returns 1 with Unicode 3 compliance
list [regexp {^[[:space:]]+$} \u1680] [regexp {^\s+$} \u1680]
} {1 1}
@@ -336,16 +336,3 @@ test utf-25.4 {Tcl_UniCharNcasecmp} teststringobj {
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-