diff options
| -rw-r--r-- | ChangeLog | 12 | ||||
| -rw-r--r-- | tests/foreach.test | 36 | ||||
| -rw-r--r-- | tests/format.test | 24 | ||||
| -rw-r--r-- | tests/if-old.test | 22 | ||||
| -rw-r--r-- | tests/incr-old.test | 16 | ||||
| -rw-r--r-- | tests/info.test | 10 | ||||
| -rw-r--r-- | tests/list.test | 57 | ||||
| -rw-r--r-- | tests/lsearch.test | 22 | ||||
| -rw-r--r-- | tests/trace.test | 25 | ||||
| -rw-r--r-- | tests/utf.test | 19 |
10 files changed, 94 insertions, 149 deletions
@@ -1,3 +1,15 @@ +2003-03-27 Donal K. Fellows <fellowsd@cs.man.ac.uk> + + * tests/utf.test: Altered test numers to eliminate duplicates. + * tests/trace.test: [Bugs 710322, 710327, 710349, 710363] + * tests/lsearch.test: + * tests/list.test: + * tests/info.test: + * tests/incr-old.test: + * tests/if-old.test: + * tests/format.test: + * tests/foreach.test: + 2003-03-26 Mo DeJong <mdejong@users.sourceforge.net> * unix/configure: Regen. diff --git a/tests/foreach.test b/tests/foreach.test index fa5b3ea..9f4b5b0 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.9 2003/03/27 13:19:15 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 541176e..7c383ee 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.13 2003/03/18 00:55:33 mdejong Exp $ +# RCS: @(#) $Id: format.test,v 1.14 2003/03/27 13:19:15 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.9 {string formatting, width} { +test format-2.10 {string formatting, width} { format "a%-5sa" f } "af a" -test format-2.10 {string formatting, width} { +test format-2.11 {string formatting, width} { format "a%2sa" foo } "afooa" -test format-2.11 {string formatting, width} { +test format-2.12 {string formatting, width} { format "a%0sa" foo } "afooa" -test format-2.12 {string formatting, precision} { +test format-2.13 {string formatting, precision} { format "a%.2sa" foobarbaz } "afoa" -test format-2.13 {string formatting, precision} { +test format-2.14 {string formatting, precision} { format "a%.sa" foobarbaz } "aa" -test format-2.14 {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.15 {string formatting, width and precision} { +test format-2.16 {string formatting, width and precision} { format "a%5.2sa" foobarbaz } "a foa" -test format-2.16 {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..3a850b9 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.6 2003/03/27 13:19:15 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..baf5e38 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.7 2003/03/27 13:19:15 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..30ce636 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.25 2003/03/27 13:19:15 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..8dd3817 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.6 2003/03/27 13:19: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..b1ab6fc 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.11 2003/03/27 13:19:15 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..263b402 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.27 2003/03/27 13:19:15 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 0e1b315..3482c22 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.9 2003/03/06 23:27:14 dgp Exp $ +# RCS: @(#) $Id: utf.test,v 1.10 2003/03/27 13:19:15 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 - - - - - - - - - - - - - |