diff options
| -rw-r--r-- | ChangeLog | 11 | ||||
| -rw-r--r-- | tests/async.test | 15 | ||||
| -rw-r--r-- | tests/basic.test | 7 | ||||
| -rw-r--r-- | tests/dict.test | 8 | ||||
| -rw-r--r-- | tests/dstring.test | 79 | ||||
| -rw-r--r-- | tests/list.test | 4 | ||||
| -rw-r--r-- | tests/parse.test | 6 | ||||
| -rw-r--r-- | tests/util.test | 41 |
8 files changed, 159 insertions, 12 deletions
@@ -1,3 +1,14 @@ +2003-07-24 Don Porter <dgp@users.sourceforge.net> + + * tests/async.test: Added several tests that demonstrate Tcl + * tests/basic.test: Bug 489537, Tcl's longstanding failure to + * tests/dict.test: properly quote any leading '#' character + * tests/dstring.test: when generating the string rep of a list + * tests/list.test: so that the comment-power of that character + * tests/parse.test: is hidden from any [eval], in order to + * tests/util.test: satisfy the documentation that [list] does + [eval]-safe quoting. + 2003-07-24 Reinhard Max <max@suse.de> * library/package.tcl: Fixed a typo that broke pkg_mkIndex -verbose. diff --git a/tests/async.test b/tests/async.test index 307a707..af63413 100644 --- a/tests/async.test +++ b/tests/async.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: async.test,v 1.5 2000/04/10 17:18:56 ericm Exp $ +# RCS: @(#) $Id: async.test,v 1.6 2003/07/24 16:05:24 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -42,10 +42,17 @@ proc async3 {result code} { set aresult "test pattern" return -code $code $result } +proc \# {result code} { + global aresult acode + set aresult $result + set acode $code + return "comment quoting" +} set handler1 [testasync create async1] set handler2 [testasync create async2] set handler3 [testasync create async3] +set handler4 [testasync create #] test async-1.1 {basic async handlers} { set aresult xxx set acode yyy @@ -78,6 +85,12 @@ test async-1.6 {basic async handlers} { set aresult xxx list [catch {testasync mark $handler3 "foobar" 1} msg] $msg $aresult } {1 foobar {test pattern}} +test async-1.7 {basic async handlers} { + set aresult xxx + set acode yyy + list [catch {testasync mark $handler4 "original" 0} msg] $msg \ + $acode $aresult +} {0 {comment quoting} 0 original} proc mult1 {result code} { global x diff --git a/tests/basic.test b/tests/basic.test index fac8dbf..a16220c 100644 --- a/tests/basic.test +++ b/tests/basic.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: basic.test,v 1.28 2003/06/25 23:02:11 dkf Exp $ +# RCS: @(#) $Id: basic.test,v 1.29 2003/07/24 16:05:24 dgp Exp $ # package require tcltest 2 @@ -317,6 +317,11 @@ test basic-20.2 {Tcl_GetCommandInfo, names for commands created outside namespac [rename test_ns_basic::test_ns_basic2::p q] \ [testcmdtoken name $x] } {{p ::test_ns_basic::test_ns_basic2::p} {} {q ::q}} +test basic-20.3 {Tcl_GetCommandInfo, #-quoting} { + catch {rename \# ""} + set x [testcmdtoken create \#] + testcmdtoken name $x +} {{#} ::#} test basic-21.1 {Tcl_GetCommandName} {emptyTest} { } {} diff --git a/tests/dict.test b/tests/dict.test index d139c54..f9c5c5a 100644 --- a/tests/dict.test +++ b/tests/dict.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: dict.test,v 1.2 2003/04/07 10:12:12 dkf Exp $ +# RCS: @(#) $Id: dict.test,v 1.3 2003/07/24 16:05:24 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -70,6 +70,12 @@ test dict-2.6 {dict create command - initialse refcount field!} { list [dict incr dictv a] } } {} +test dict-2.7 {dict create command - #-quoting in string rep} { + dict create # #comment +} {{#} #comment} +test dict-2.8 {dict create command - #-quoting in string rep} -body { + dict create #a x #b x +} -match glob -result {{#?} x #? x} test dict-3.1 {dict get command} {dict get {a b} a} b test dict-3.2 {dict get command} {dict get {a b c d} a} b diff --git a/tests/dstring.test b/tests/dstring.test index 6c9276b..5a8b3b2 100644 --- a/tests/dstring.test +++ b/tests/dstring.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: dstring.test,v 1.5 2000/04/10 17:18:58 ericm Exp $ +# RCS: @(#) $Id: dstring.test,v 1.6 2003/07/24 16:05:24 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -113,6 +113,37 @@ test dstring-2.8 {appending list elements} { testdstring element abc testdstring get } {x abc} +test dstring-2.9 {appending list elements} { + testdstring free + testdstring element # + testdstring get +} {{#}} +test dstring-2.10 {appending list elements} { + testdstring free + testdstring append " " -1 + testdstring element # + testdstring get +} { {#}} +test dstring-2.11 {appending list elements} { + testdstring free + testdstring append \t -1 + testdstring element # + testdstring get +} \t{#} +test dstring-2.12 {appending list elements} { + testdstring free + testdstring append x -1 + testdstring element # + testdstring get +} {x #} +test dstring-2.13 {appending list elements} { + # This test shows lack of sophistication in Tcl_DStringAppendElement's + # decision about whether #-quoting can be disabled. + testdstring free + testdstring append "x " -1 + testdstring element # + testdstring get +} {x {#}} test dstring-3.1 {nested sublists} { testdstring free @@ -167,6 +198,52 @@ test dstring-3.5 {nested sublists} { testdstring end testdstring get } {\{ {first second}} +test dstring-3.6 {appending list elements} { + testdstring free + testdstring append x -1 + testdstring start + testdstring element # + testdstring end + testdstring get +} {x {{#}}} +test dstring-3.7 {appending list elements} { + testdstring free + testdstring append x -1 + testdstring start + testdstring append " " -1 + testdstring element # + testdstring end + testdstring get +} {x { {#}}} +test dstring-3.8 {appending list elements} { + testdstring free + testdstring append x -1 + testdstring start + testdstring append \t -1 + testdstring element # + testdstring end + testdstring get +} "x {\t{#}}" +test dstring-3.9 {appending list elements} { + testdstring free + testdstring append x -1 + testdstring start + testdstring append x -1 + testdstring element # + testdstring end + testdstring get +} {x {x #}} +test dstring-3.10 {appending list elements} { + # This test shows lack of sophistication in Tcl_DStringAppendElement's + # decision about whether #-quoting can be disabled. + testdstring free + testdstring append x -1 + testdstring start + testdstring append "x " -1 + testdstring element # + testdstring end + testdstring get +} {x {x {#}}} test dstring-4.1 {truncation} { testdstring free diff --git a/tests/list.test b/tests/list.test index 8dd3817..01dc060 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.6 2003/03/27 13:19:15 dkf Exp $ +# RCS: @(#) $Id: list.test,v 1.7 2003/07/24 16:05:24 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -44,6 +44,8 @@ test list-1.21 {basic tests} {list a b c\\\nd} "a b c\\\\\\nd" test list-1.22 {basic tests} {list "{ab}\\"} \\{ab\\}\\\\ test list-1.23 {basic tests} {list \{} "\\{" test list-1.24 {basic tests} {list} {} +test list-1.25 {basic tests} {list # #} {{#} #} +test list-1.26 {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. diff --git a/tests/parse.test b/tests/parse.test index 9764cf1..ee2a772 100644 --- a/tests/parse.test +++ b/tests/parse.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: parse.test,v 1.15 2003/04/01 17:08:16 dgp Exp $ +# RCS: @(#) $Id: parse.test,v 1.16 2003/07/24 16:05:24 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -58,10 +58,10 @@ test parse-2.2 {Tcl_ParseCommand procedure, several comments} { } foo 1 simple foo 1 text foo 0 {}} test parse-2.3 {Tcl_ParseCommand procedure, backslash-newline in comments} { testparser " # foo bar\\\ncomment on continuation line\nfoo" 0 -} {#\ foo\ bar\\\ncomment\ on\ continuation\ line\n foo 1 simple foo 1 text foo 0 {}} +} {\#\ foo\ bar\\\ncomment\ on\ continuation\ line\n foo 1 simple foo 1 text foo 0 {}} test parse-2.4 {Tcl_ParseCommand procedure, missing continuation line in comment} { testparser "# \\\n" 0 -} {#\ \ \ \\\n {} 0 {}} +} {\#\ \ \ \\\n {} 0 {}} test parse-2.5 {Tcl_ParseCommand procedure, eof in comment} { testparser " # foo bar\nfoo" 8 } {{# foo b} {} 0 {ar diff --git a/tests/util.test b/tests/util.test index fe94732..22b1dbc 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.10 2002/01/02 13:52:04 dkf Exp $ +# RCS: @(#) $Id: util.test,v 1.11 2003/07/24 16:05:24 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -43,10 +43,43 @@ test util-3.1 {Tcl_ScanCountedElement procedure - don't leave unmatched braces} # Tcl_DStringStartSublist doesn't work. set x {} - lappend x " \\\{ \\" + lappend x "# \\\{ \\" concat $x [llength "{$x}"] -} {\ \\\{\ \\ 1} - +} {\#\ \\\{\ \\ 1} +test util-3.2 {Tcl_ConverCountedElement procedure - quote leading '#'} { + list # # a +} {{#} # a} +test util-3.3 {Tcl_ConverCountedElement procedure - quote leading '#'} { + list #\{ # a +} {\#\{ # a} +test util-3.4 {Tcl_ConverCountedElement procedure - quote leading '#'} { + proc # {} {return #} + set result [eval [list #]] + rename # {} + set result +} {#} +test util-3.4.1 {Tcl_ConverCountedElement procedure - quote leading '#'} { + proc # {} {return #} + set cmd [list #] + append cmd "" ;# force string rep generation + set result [eval $cmd] + rename # {} + set result +} {#} +test util-3.5 {Tcl_ConverCountedElement procedure - quote leading '#'} { + proc #\{ {} {return #} + set result [eval [list #\{]] + rename #\{ {} + set result +} {#} +test util-3.5.1 {Tcl_ConverCountedElement procedure - quote leading '#'} { + proc #\{ {} {return #} + set cmd [list #\{] + append cmd "" ;# force string rep generation + set result [eval $cmd] + rename #\{ {} + set result +} {#} test util-4.1 {Tcl_ConcatObj - backslash-space at end of argument} { concat a {b\ } c } {a b\ c} |