summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2003-07-24 16:05:22 (GMT)
committerdgp <dgp@users.sourceforge.net>2003-07-24 16:05:22 (GMT)
commitdb3db9df91cdc7d1b0bdac6c9c927765ce9afd95 (patch)
tree829c6228c7d8db111e9b0b193de20a6c182b21be
parent69bc2d2dcd6bd96a75ea42e0fdb1c23fc1054390 (diff)
downloadtcl-db3db9df91cdc7d1b0bdac6c9c927765ce9afd95.zip
tcl-db3db9df91cdc7d1b0bdac6c9c927765ce9afd95.tar.gz
tcl-db3db9df91cdc7d1b0bdac6c9c927765ce9afd95.tar.bz2
* 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.
-rw-r--r--ChangeLog11
-rw-r--r--tests/async.test15
-rw-r--r--tests/basic.test7
-rw-r--r--tests/dict.test8
-rw-r--r--tests/dstring.test79
-rw-r--r--tests/list.test4
-rw-r--r--tests/parse.test6
-rw-r--r--tests/util.test41
8 files changed, 159 insertions, 12 deletions
diff --git a/ChangeLog b/ChangeLog
index a6f921e..9550813 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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}