1 | # This file contains a collection of tests for the procedures in the |
---|
2 | # file tclParse.c. Sourcing this file into Tcl runs the tests and |
---|
3 | # generates output for errors. No output means no errors were found. |
---|
4 | # |
---|
5 | # Copyright (c) 1997 Sun Microsystems, Inc. |
---|
6 | # Copyright (c) 1998-1999 by Scriptics Corporation. |
---|
7 | # |
---|
8 | # See the file "license.terms" for information on usage and redistribution |
---|
9 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
10 | # |
---|
11 | # RCS: @(#) $Id: parse.test,v 1.30 2007/12/13 15:26:07 dgp Exp $ |
---|
12 | |
---|
13 | if {[catch {package require tcltest 2.0.2}]} { |
---|
14 | puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." |
---|
15 | return |
---|
16 | } |
---|
17 | |
---|
18 | namespace eval ::tcl::test::parse { |
---|
19 | namespace import ::tcltest::* |
---|
20 | |
---|
21 | testConstraint testparser [llength [info commands testparser]] |
---|
22 | testConstraint testevalobjv [llength [info commands testevalobjv]] |
---|
23 | testConstraint testevalex [llength [info commands testevalex]] |
---|
24 | testConstraint testparsevarname [llength [info commands testparsevarname]] |
---|
25 | testConstraint testparsevar [llength [info commands testparsevar]] |
---|
26 | testConstraint testasync [llength [info commands testasync]] |
---|
27 | testConstraint testcmdtrace [llength [info commands testcmdtrace]] |
---|
28 | |
---|
29 | test parse-1.1 {Tcl_ParseCommand procedure, computing string length} testparser { |
---|
30 | testparser [bytestring "foo\0 bar"] -1 |
---|
31 | } {- foo 1 simple foo 1 text foo 0 {}} |
---|
32 | test parse-1.2 {Tcl_ParseCommand procedure, computing string length} testparser { |
---|
33 | testparser "foo bar" -1 |
---|
34 | } {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} |
---|
35 | test parse-1.3 {Tcl_ParseCommand procedure, leading space} testparser { |
---|
36 | testparser " \n\t foo" 0 |
---|
37 | } {- foo 1 simple foo 1 text foo 0 {}} |
---|
38 | test parse-1.4 {Tcl_ParseCommand procedure, leading space} testparser { |
---|
39 | testparser "\f\r\vfoo" 0 |
---|
40 | } {- foo 1 simple foo 1 text foo 0 {}} |
---|
41 | test parse-1.5 {Tcl_ParseCommand procedure, backslash-newline in leading space} testparser { |
---|
42 | testparser " \\\n foo" 0 |
---|
43 | } {- foo 1 simple foo 1 text foo 0 {}} |
---|
44 | test parse-1.6 {Tcl_ParseCommand procedure, backslash-newline in leading space} testparser { |
---|
45 | testparser { \a foo} 0 |
---|
46 | } {- {\a foo} 2 word {\a} 1 backslash {\a} 0 simple foo 1 text foo 0 {}} |
---|
47 | test parse-1.7 {Tcl_ParseCommand procedure, missing continuation line in leading space} testparser { |
---|
48 | testparser " \\\n" 0 |
---|
49 | } {- {} 0 {}} |
---|
50 | test parse-1.8 {Tcl_ParseCommand procedure, eof in leading space} testparser { |
---|
51 | testparser " foo" 3 |
---|
52 | } {- {} 0 { foo}} |
---|
53 | test parse-1.9 {Tcl_ParseCommand procedure, backslash newline + newline} testparser { |
---|
54 | testparser "cmd1\\\n\ncmd2" 0 |
---|
55 | } {- cmd1\\\n\n 1 simple cmd1 1 text cmd1 0 cmd2} |
---|
56 | test parse-1.10 {Tcl_ParseCommand procedure, backslash newline + newline} testparser { |
---|
57 | testparser "list \\\nA B\\\n\nlist C D" 0 |
---|
58 | } {- list\ \\\nA\ B\\\n\n 3 simple list 1 text list 0 simple A 1 text A 0 simple B 1 text B 0 {list C D}} |
---|
59 | |
---|
60 | test parse-2.1 {Tcl_ParseCommand procedure, comments} testparser { |
---|
61 | testparser "# foo bar\n foo" 0 |
---|
62 | } {{# foo bar |
---|
63 | } foo 1 simple foo 1 text foo 0 {}} |
---|
64 | test parse-2.2 {Tcl_ParseCommand procedure, several comments} testparser { |
---|
65 | testparser " # foo bar\n # another comment\n\n foo" 0 |
---|
66 | } {{# foo bar |
---|
67 | # another comment |
---|
68 | } foo 1 simple foo 1 text foo 0 {}} |
---|
69 | test parse-2.3 {Tcl_ParseCommand procedure, backslash-newline in comments} testparser { |
---|
70 | testparser " # foo bar\\\ncomment on continuation line\nfoo" 0 |
---|
71 | } {\#\ foo\ bar\\\ncomment\ on\ continuation\ line\n foo 1 simple foo 1 text foo 0 {}} |
---|
72 | test parse-2.4 {Tcl_ParseCommand procedure, missing continuation line in comment} testparser { |
---|
73 | testparser "# \\\n" 0 |
---|
74 | } {\#\ \ \ \\\n {} 0 {}} |
---|
75 | test parse-2.5 {Tcl_ParseCommand procedure, eof in comment} testparser { |
---|
76 | testparser " # foo bar\nfoo" 8 |
---|
77 | } {{# foo b} {} 0 {ar |
---|
78 | foo}} |
---|
79 | |
---|
80 | test parse-3.1 {Tcl_ParseCommand procedure, parsing words, skipping space} testparser { |
---|
81 | testparser "foo bar\t\tx" 0 |
---|
82 | } {- {foo bar x} 3 simple foo 1 text foo 0 simple bar 1 text bar 0 simple x 1 text x 0 {}} |
---|
83 | test parse-3.2 {Tcl_ParseCommand procedure, missing continuation line in leading space} testparser { |
---|
84 | testparser "abc \\\n" 0 |
---|
85 | } {- abc\ \ \\\n 1 simple abc 1 text abc 0 {}} |
---|
86 | test parse-3.3 {Tcl_ParseCommand procedure, parsing words, command ends in space} testparser { |
---|
87 | testparser "foo ; bar x" 0 |
---|
88 | } {- {foo ;} 1 simple foo 1 text foo 0 { bar x}} |
---|
89 | test parse-3.4 {Tcl_ParseCommand procedure, parsing words, command ends in space} testparser { |
---|
90 | testparser "foo " 5 |
---|
91 | } {- {foo } 1 simple foo 1 text foo 0 { }} |
---|
92 | test parse-3.5 {Tcl_ParseCommand procedure, quoted words} testparser { |
---|
93 | testparser {foo "a b c" d "efg";} 0 |
---|
94 | } {- {foo "a b c" d "efg";} 4 simple foo 1 text foo 0 simple {"a b c"} 1 text {a b c} 0 simple d 1 text d 0 simple {"efg"} 1 text efg 0 {}} |
---|
95 | test parse-3.6 {Tcl_ParseCommand procedure, words in braces} testparser { |
---|
96 | testparser {foo {a $b [concat foo]} {c d}} 0 |
---|
97 | } {- {foo {a $b [concat foo]} {c d}} 3 simple foo 1 text foo 0 simple {{a $b [concat foo]}} 1 text {a $b [concat foo]} 0 simple {{c d}} 1 text {c d} 0 {}} |
---|
98 | test parse-3.7 {Tcl_ParseCommand procedure, error in unquoted word} testparser { |
---|
99 | list [catch {testparser "foo \$\{abc" 0} msg] $msg $::errorInfo |
---|
100 | } {1 {missing close-brace for variable name} missing\ close-brace\ for\ variable\ name\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"foo\ \\\$\\\{abc\"\ 0\"} |
---|
101 | |
---|
102 | test parse-4.1 {Tcl_ParseCommand procedure, simple words} testparser { |
---|
103 | testparser {foo} 0 |
---|
104 | } {- foo 1 simple foo 1 text foo 0 {}} |
---|
105 | test parse-4.2 {Tcl_ParseCommand procedure, simple words} testparser { |
---|
106 | testparser {{abc}} 0 |
---|
107 | } {- {{abc}} 1 simple {{abc}} 1 text abc 0 {}} |
---|
108 | test parse-4.3 {Tcl_ParseCommand procedure, simple words} testparser { |
---|
109 | testparser {"c d"} 0 |
---|
110 | } {- {"c d"} 1 simple {"c d"} 1 text {c d} 0 {}} |
---|
111 | test parse-4.4 {Tcl_ParseCommand procedure, simple words} testparser { |
---|
112 | testparser {x$d} 0 |
---|
113 | } {- {x$d} 1 word {x$d} 3 text x 0 variable {$d} 1 text d 0 {}} |
---|
114 | test parse-4.5 {Tcl_ParseCommand procedure, simple words} testparser { |
---|
115 | testparser {"a [foo] b"} 0 |
---|
116 | } {- {"a [foo] b"} 1 word {"a [foo] b"} 3 text {a } 0 command {[foo]} 0 text { b} 0 {}} |
---|
117 | test parse-4.6 {Tcl_ParseCommand procedure, simple words} testparser { |
---|
118 | testparser {$x} 0 |
---|
119 | } {- {$x} 1 word {$x} 2 variable {$x} 1 text x 0 {}} |
---|
120 | |
---|
121 | test parse-5.1 {Tcl_ParseCommand procedure, backslash-newline terminates word} testparser { |
---|
122 | testparser "{abc}\\\n" 0 |
---|
123 | } {- \{abc\}\\\n 1 simple {{abc}} 1 text abc 0 {}} |
---|
124 | test parse-5.2 {Tcl_ParseCommand procedure, backslash-newline terminates word} testparser { |
---|
125 | testparser "foo\\\nbar" 0 |
---|
126 | } {- foo\\\nbar 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} |
---|
127 | test parse-5.3 {Tcl_ParseCommand procedure, word terminator is command terminator} testparser { |
---|
128 | testparser "foo\n bar" 0 |
---|
129 | } {- {foo |
---|
130 | } 1 simple foo 1 text foo 0 { bar}} |
---|
131 | test parse-5.4 {Tcl_ParseCommand procedure, word terminator is command terminator} testparser { |
---|
132 | testparser "foo; bar" 0 |
---|
133 | } {- {foo;} 1 simple foo 1 text foo 0 { bar}} |
---|
134 | test parse-5.5 {Tcl_ParseCommand procedure, word terminator is end of string} testparser { |
---|
135 | testparser "\"foo\" bar" 5 |
---|
136 | } {- {"foo"} 1 simple {"foo"} 1 text foo 0 { bar}} |
---|
137 | test parse-5.6 {Tcl_ParseCommand procedure, junk after close quote} testparser { |
---|
138 | list [catch {testparser {foo "bar"x} 0} msg] $msg $::errorInfo |
---|
139 | } {1 {extra characters after close-quote} {extra characters after close-quote |
---|
140 | (remainder of script: "x") |
---|
141 | invoked from within |
---|
142 | "testparser {foo "bar"x} 0"}} |
---|
143 | test parse-5.7 {Tcl_ParseCommand procedure, backslash-newline after close quote} testparser { |
---|
144 | testparser "foo \"bar\"\\\nx" 0 |
---|
145 | } {- foo\ \"bar\"\\\nx 3 simple foo 1 text foo 0 simple {"bar"} 1 text bar 0 simple x 1 text x 0 {}} |
---|
146 | test parse-5.8 {Tcl_ParseCommand procedure, junk after close brace} testparser { |
---|
147 | list [catch {testparser {foo {bar}x} 0} msg] $msg $::errorInfo |
---|
148 | } {1 {extra characters after close-brace} {extra characters after close-brace |
---|
149 | (remainder of script: "x") |
---|
150 | invoked from within |
---|
151 | "testparser {foo {bar}x} 0"}} |
---|
152 | test parse-5.9 {Tcl_ParseCommand procedure, backslash-newline after close brace} testparser { |
---|
153 | testparser "foo {bar}\\\nx" 0 |
---|
154 | } {- foo\ \{bar\}\\\nx 3 simple foo 1 text foo 0 simple {{bar}} 1 text bar 0 simple x 1 text x 0 {}} |
---|
155 | test parse-5.10 {Tcl_ParseCommand procedure, multiple deletion of non-static buffer} testparser { |
---|
156 | # This test is designed to catch bug 1681. |
---|
157 | list [catch {testparser "a \"\\1\\2\\3\\4\\5\\6\\7\\8\\9\\1\\2\\3\\4\\5\\6\\7\\8" 0} msg] $msg $::errorInfo |
---|
158 | } "1 {missing \"} {missing \" |
---|
159 | (remainder of script: \"\"\\1\\2\\3\\4\\5\\6\\7\\8\\9\\1\\2\\3\\4\\5\\6\\7\\8\") |
---|
160 | invoked from within |
---|
161 | \"testparser \"a \\\"\\\\1\\\\2\\\\3\\\\4\\\\5\\\\6\\\\7\\\\8\\\\9\\\\1\\\\2\\\\3\\\\4\\\\5\\\\6\\\\7\\\\8\" 0\"}" |
---|
162 | |
---|
163 | test parse-5.11 {Tcl_ParseCommand: {*} parsing} testparser { |
---|
164 | testparser {{expan}} 0 |
---|
165 | } {- {{expan}} 1 simple {{expan}} 1 text expan 0 {}} |
---|
166 | test parse-5.12 {Tcl_ParseCommand: {*} parsing} -constraints { |
---|
167 | testparser |
---|
168 | } -body { |
---|
169 | testparser {{expan}x} 0 |
---|
170 | } -returnCodes error -result {extra characters after close-brace} |
---|
171 | test parse-5.13 {Tcl_ParseCommand: {*} parsing} testparser { |
---|
172 | testparser {{**}} 0 |
---|
173 | } {- {{**}} 1 simple {{**}} 1 text ** 0 {}} |
---|
174 | test parse-5.14 {Tcl_ParseCommand: {*} parsing} -constraints { |
---|
175 | testparser |
---|
176 | } -body { |
---|
177 | testparser {{**}x} 0 |
---|
178 | } -returnCodes error -result {extra characters after close-brace} |
---|
179 | test parse-5.15 {Tcl_ParseCommand: {*} parsing} -constraints { |
---|
180 | testparser |
---|
181 | } -body { |
---|
182 | testparser {{*}{123456}x} 0 |
---|
183 | } -returnCodes error -result {extra characters after close-brace} |
---|
184 | test parse-5.16 {Tcl_ParseCommand: {*} parsing} testparser { |
---|
185 | testparser {{123456\ |
---|
186 | }} 0 |
---|
187 | } {- {{123456 }} 1 simple {{123456 }} 1 text {123456 } 0 {}} |
---|
188 | test parse-5.17 {Tcl_ParseCommand: {*} parsing} -constraints { |
---|
189 | testparser |
---|
190 | } -body { |
---|
191 | testparser {{123456\ |
---|
192 | }x} 0 |
---|
193 | } -returnCodes error -result {extra characters after close-brace} |
---|
194 | test parse-5.18 {Tcl_ParseCommand: {*} parsing} testparser { |
---|
195 | testparser {{*\ |
---|
196 | }} 0 |
---|
197 | } {- {{* }} 1 simple {{* }} 1 text {* } 0 {}} |
---|
198 | test parse-5.19 {Tcl_ParseCommand: {*} parsing} -constraints { |
---|
199 | testparser |
---|
200 | } -body { |
---|
201 | testparser {{*\ |
---|
202 | }x} 0 |
---|
203 | } -returnCodes error -result {extra characters after close-brace} |
---|
204 | test parse-5.20 {Tcl_ParseCommand: {*} parsing} testparser { |
---|
205 | testparser {{123456}} 0 |
---|
206 | } {- {{123456}} 1 simple {{123456}} 1 text 123456 0 {}} |
---|
207 | test parse-5.21 {Tcl_ParseCommand: {*} parsing} -constraints { |
---|
208 | testparser |
---|
209 | } -body { |
---|
210 | testparser {{123456}x} 0 |
---|
211 | } -returnCodes error -result {extra characters after close-brace} |
---|
212 | test parse-5.22 {Tcl_ParseCommand: {*} parsing} testparser { |
---|
213 | testparser {{*}} 0 |
---|
214 | } {- {{*}} 1 simple {{*}} 1 text * 0 {}} |
---|
215 | test parse-5.23 {Tcl_ParseCommand: {*} parsing} testparser { |
---|
216 | testparser {{*} } 0 |
---|
217 | } {- {{*} } 1 simple {{*}} 1 text * 0 {}} |
---|
218 | test parse-5.24 {Tcl_ParseCommand: {*} parsing} testparser { |
---|
219 | testparser {{*}x} 0 |
---|
220 | } {- {{*}x} 1 simple x 1 text x 0 {}} |
---|
221 | test parse-5.25 {Tcl_ParseCommand: {*} parsing} testparser { |
---|
222 | testparser {{*} |
---|
223 | } 0 |
---|
224 | } {- {{*} |
---|
225 | } 1 simple {{*}} 1 text * 0 {}} |
---|
226 | test parse-5.26 {Tcl_ParseCommand: {*} parsing} testparser { |
---|
227 | testparser {{*};} 0 |
---|
228 | } {- {{*};} 1 simple {{*}} 1 text * 0 {}} |
---|
229 | test parse-5.27 {Tcl_ParseCommand: {*} parsing} testparser { |
---|
230 | testparser "{*}\\\n foo bar" 0 |
---|
231 | } {- \{*\}\\\n\ foo\ bar 3 simple {{*}} 1 text * 0 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} |
---|
232 | |
---|
233 | test parse-6.1 {ParseTokens procedure, empty word} testparser { |
---|
234 | testparser {""} 0 |
---|
235 | } {- {""} 1 simple {""} 1 text {} 0 {}} |
---|
236 | test parse-6.2 {ParseTokens procedure, simple range} testparser { |
---|
237 | testparser {"abc$x.e"} 0 |
---|
238 | } {- {"abc$x.e"} 1 word {"abc$x.e"} 4 text abc 0 variable {$x} 1 text x 0 text .e 0 {}} |
---|
239 | test parse-6.3 {ParseTokens procedure, variable reference} testparser { |
---|
240 | testparser {abc$x.e $y(z)} 0 |
---|
241 | } {- {abc$x.e $y(z)} 2 word {abc$x.e} 4 text abc 0 variable {$x} 1 text x 0 text .e 0 word {$y(z)} 3 variable {$y(z)} 2 text y 0 text z 0 {}} |
---|
242 | test parse-6.4 {ParseTokens procedure, variable reference} testparser { |
---|
243 | list [catch {testparser {$x([a )} 0} msg] $msg |
---|
244 | } {1 {missing close-bracket}} |
---|
245 | test parse-6.5 {ParseTokens procedure, command substitution} testparser { |
---|
246 | testparser {[foo $x bar]z} 0 |
---|
247 | } {- {[foo $x bar]z} 1 word {[foo $x bar]z} 2 command {[foo $x bar]} 0 text z 0 {}} |
---|
248 | test parse-6.6 {ParseTokens procedure, command substitution} testparser { |
---|
249 | testparser {[foo \] [a b]]} 0 |
---|
250 | } {- {[foo \] [a b]]} 1 word {[foo \] [a b]]} 1 command {[foo \] [a b]]} 0 {}} |
---|
251 | test parse-6.7 {ParseTokens procedure, error in command substitution} testparser { |
---|
252 | list [catch {testparser {a [b {}c d] e} 0} msg] $msg $::errorInfo |
---|
253 | } {1 {extra characters after close-brace} {extra characters after close-brace |
---|
254 | (remainder of script: "c d] e") |
---|
255 | invoked from within |
---|
256 | "testparser {a [b {}c d] e} 0"}} |
---|
257 | test parse-6.8 {ParseTokens procedure, error in command substitution} { |
---|
258 | info complete {a [b {}c d]} |
---|
259 | } {1} |
---|
260 | test parse-6.9 {ParseTokens procedure, error in command substitution} { |
---|
261 | info complete {a [b "c d} |
---|
262 | } {0} |
---|
263 | test parse-6.10 {ParseTokens procedure, incomplete sub-command} { |
---|
264 | info complete {puts [ |
---|
265 | expr 1+1 |
---|
266 | #this is a comment ]} |
---|
267 | } {0} |
---|
268 | test parse-6.11 {ParseTokens procedure, memory allocation for big nested command} testparser { |
---|
269 | testparser {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 0 |
---|
270 | } {- {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 1 word {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 1 command {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 0 {}} |
---|
271 | test parse-6.12 {ParseTokens procedure, missing close bracket} testparser { |
---|
272 | list [catch {testparser {[foo $x bar} 0} msg] $msg $::errorInfo |
---|
273 | } {1 {missing close-bracket} {missing close-bracket |
---|
274 | (remainder of script: "[foo $x bar") |
---|
275 | invoked from within |
---|
276 | "testparser {[foo $x bar} 0"}} |
---|
277 | test parse-6.13 {ParseTokens procedure, backslash-newline without continuation line} testparser { |
---|
278 | list [catch {testparser "\"a b\\\n" 0} msg] $msg $::errorInfo |
---|
279 | } {1 {missing "} missing\ \"\n\ \ \ \ (remainder\ of\ script:\ \"\"a\ b\\\n\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\\\"a\ b\\\\\\n\"\ 0\"} |
---|
280 | test parse-6.14 {ParseTokens procedure, backslash-newline} testparser { |
---|
281 | testparser "b\\\nc" 0 |
---|
282 | } {- b\\\nc 2 simple b 1 text b 0 simple c 1 text c 0 {}} |
---|
283 | test parse-6.15 {ParseTokens procedure, backslash-newline} testparser { |
---|
284 | testparser "\"b\\\nc\"" 0 |
---|
285 | } {- \"b\\\nc\" 1 word \"b\\\nc\" 3 text b 0 backslash \\\n 0 text c 0 {}} |
---|
286 | test parse-6.16 {ParseTokens procedure, backslash substitution} testparser { |
---|
287 | testparser {\n\a\x7f} 0 |
---|
288 | } {- {\n\a\x7f} 1 word {\n\a\x7f} 3 backslash {\n} 0 backslash {\a} 0 backslash {\x7f} 0 {}} |
---|
289 | test parse-6.17 {ParseTokens procedure, null characters} testparser { |
---|
290 | testparser [bytestring "foo\0zz"] 0 |
---|
291 | } "- [bytestring foo\0zz] 1 word [bytestring foo\0zz] 3 text foo 0 text [bytestring \0] 0 text zz 0 {}" |
---|
292 | test parse-6.18 {ParseTokens procedure, seek past numBytes for close-bracket} testparser { |
---|
293 | # Test for Bug 681841 |
---|
294 | list [catch {testparser {[a]} 2} msg] $msg |
---|
295 | } {1 {missing close-bracket}} |
---|
296 | |
---|
297 | test parse-7.1 {Tcl_FreeParse and ExpandTokenArray procedures} testparser { |
---|
298 | testparser {$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) } 0 |
---|
299 | } {- {$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) } 16 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 word {$a(b)} 3 variable {$a(b)} 2 text a 0 text b 0 {}} |
---|
300 | |
---|
301 | test parse-8.1 {Tcl_EvalObjv procedure} testevalobjv { |
---|
302 | testevalobjv 0 concat this is a test |
---|
303 | } {this is a test} |
---|
304 | test parse-8.2 {Tcl_EvalObjv procedure, unknown commands} testevalobjv { |
---|
305 | rename ::unknown unknown.old |
---|
306 | set x [catch {testevalobjv 10 asdf poiu} msg] |
---|
307 | rename unknown.old ::unknown |
---|
308 | list $x $msg |
---|
309 | } {1 {invalid command name "asdf"}} |
---|
310 | test parse-8.3 {Tcl_EvalObjv procedure, unknown commands} testevalobjv { |
---|
311 | rename ::unknown unknown.old |
---|
312 | proc ::unknown args { |
---|
313 | return "unknown $args" |
---|
314 | } |
---|
315 | set x [catch {testevalobjv 0 asdf poiu} msg] |
---|
316 | rename ::unknown {} |
---|
317 | rename unknown.old ::unknown |
---|
318 | list $x $msg |
---|
319 | } {0 {unknown asdf poiu}} |
---|
320 | test parse-8.4 {Tcl_EvalObjv procedure, unknown commands} testevalobjv { |
---|
321 | rename ::unknown unknown.old |
---|
322 | proc ::unknown args { |
---|
323 | error "I don't like that command" |
---|
324 | } |
---|
325 | set x [catch {testevalobjv 0 asdf poiu} msg] |
---|
326 | rename ::unknown {} |
---|
327 | rename unknown.old ::unknown |
---|
328 | list $x $msg |
---|
329 | } {1 {I don't like that command}} |
---|
330 | test parse-8.5 {Tcl_EvalObjv procedure, command traces} {testevalobjv testcmdtrace} { |
---|
331 | testevalobjv 0 set x 123 |
---|
332 | testcmdtrace tracetest {testevalobjv 0 set x $x} |
---|
333 | } {{testevalobjv 0 set x $x} {testevalobjv 0 set x 123} {set x 123} {set x 123}} |
---|
334 | test parse-8.7 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL flag} -constraints { |
---|
335 | testevalobjv |
---|
336 | } -setup { |
---|
337 | proc x {} { |
---|
338 | set y 23 |
---|
339 | set z [testevalobjv 1 set y] |
---|
340 | return [list $z $y] |
---|
341 | } |
---|
342 | set ::y 16 |
---|
343 | } -cleanup { |
---|
344 | unset ::y |
---|
345 | } -body { |
---|
346 | x |
---|
347 | } -result {16 23} |
---|
348 | test parse-8.8 {Tcl_EvalObjv procedure, async handlers} -constraints { |
---|
349 | testevalobjv testasync |
---|
350 | } -setup { |
---|
351 | variable ::aresult |
---|
352 | variable ::acode |
---|
353 | proc async1 {result code} { |
---|
354 | variable ::aresult |
---|
355 | variable ::acode |
---|
356 | set aresult $result |
---|
357 | set acode $code |
---|
358 | return "new result" |
---|
359 | } |
---|
360 | set handler1 [testasync create async1] |
---|
361 | set aresult xxx |
---|
362 | set acode yyy |
---|
363 | } -cleanup { |
---|
364 | testasync delete |
---|
365 | } -body { |
---|
366 | list [testevalobjv 0 testasync mark $handler1 original 0] $acode $aresult |
---|
367 | } -result {{new result} 0 original} |
---|
368 | test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} testevalobjv { |
---|
369 | list [catch {testevalobjv 0 error message} msg] $msg |
---|
370 | } {1 message} |
---|
371 | test parse-8.10 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL} testevalobjv { |
---|
372 | rename ::unknown unknown.save |
---|
373 | proc ::unknown args {lappend ::info [info level]} |
---|
374 | catch {rename ::noSuchCommand {}} |
---|
375 | set ::info {} |
---|
376 | namespace eval test_ns_1 { |
---|
377 | testevalobjv 1 noSuchCommand |
---|
378 | uplevel #0 noSuchCommand |
---|
379 | } |
---|
380 | namespace delete test_ns_1 |
---|
381 | rename ::unknown {} |
---|
382 | rename unknown.save ::unknown |
---|
383 | set ::info |
---|
384 | } {1 1} |
---|
385 | test parse-8.11 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} testevalobjv { |
---|
386 | rename ::unknown unknown.save |
---|
387 | proc ::unknown args {lappend ::info [info level]; uplevel 1 foo} |
---|
388 | proc ::foo args {lappend ::info global} |
---|
389 | catch {rename ::noSuchCommand {}} |
---|
390 | set ::slave [interp create] |
---|
391 | $::slave alias bar noSuchCommand |
---|
392 | set ::info {} |
---|
393 | namespace eval test_ns_1 { |
---|
394 | proc foo args {lappend ::info namespace} |
---|
395 | $::slave eval bar |
---|
396 | testevalobjv 1 [list $::slave eval bar] |
---|
397 | uplevel #0 [list $::slave eval bar] |
---|
398 | } |
---|
399 | namespace delete test_ns_1 |
---|
400 | rename ::foo {} |
---|
401 | rename ::unknown {} |
---|
402 | rename unknown.save ::unknown |
---|
403 | set ::info |
---|
404 | } [subst {[set level 2; incr level [info level]] global 1 global 1 global}] |
---|
405 | test parse-8.12 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} { |
---|
406 | set ::auto_index(noSuchCommand) { |
---|
407 | proc noSuchCommand {} {lappend ::info global} |
---|
408 | } |
---|
409 | set ::auto_index(::[string trimleft [namespace current]::test_ns_1::noSuchCommand :]) [list \ |
---|
410 | proc [namespace current]::test_ns_1::noSuchCommand {} { |
---|
411 | lappend ::info ns |
---|
412 | }] |
---|
413 | catch {rename ::noSuchCommand {}} |
---|
414 | set ::slave [interp create] |
---|
415 | $::slave alias bar noSuchCommand |
---|
416 | set ::info {} |
---|
417 | namespace eval test_ns_1 { |
---|
418 | $::slave eval bar |
---|
419 | } |
---|
420 | namespace delete test_ns_1 |
---|
421 | interp delete $::slave |
---|
422 | catch {rename ::noSuchCommand {}} |
---|
423 | set ::info |
---|
424 | } global |
---|
425 | |
---|
426 | |
---|
427 | test parse-9.1 {Tcl_LogCommandInfo, line numbers} testevalex { |
---|
428 | catch {unset x} |
---|
429 | list [catch {testevalex {for {} 1 {} { |
---|
430 | |
---|
431 | |
---|
432 | # asdf |
---|
433 | set x |
---|
434 | }}}] $::errorInfo |
---|
435 | } {1 {can't read "x": no such variable |
---|
436 | while executing |
---|
437 | "set x" |
---|
438 | ("for" body line 5) |
---|
439 | invoked from within |
---|
440 | "for {} 1 {} { |
---|
441 | |
---|
442 | |
---|
443 | # asdf |
---|
444 | set x |
---|
445 | }" |
---|
446 | invoked from within |
---|
447 | "testevalex {for {} 1 {} { |
---|
448 | |
---|
449 | |
---|
450 | # asdf |
---|
451 | set x |
---|
452 | }}"}} |
---|
453 | test parse-9.2 {Tcl_LogCommandInfo, truncating long commands} { |
---|
454 | list [catch {set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee fffffffff ggggggggg}] $::errorInfo |
---|
455 | } {1 {wrong # args: should be "set varName ?newValue?" |
---|
456 | while executing |
---|
457 | "set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd ee..."}} |
---|
458 | |
---|
459 | test parse-10.1 {Tcl_EvalTokens, simple text} testevalex { |
---|
460 | testevalex {concat test} |
---|
461 | } {test} |
---|
462 | test parse-10.2 {Tcl_EvalTokens, backslash sequences} testevalex { |
---|
463 | testevalex {concat test\063\062test} |
---|
464 | } {test32test} |
---|
465 | test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex { |
---|
466 | testevalex {concat [expr 2 + 6]} |
---|
467 | } {8} |
---|
468 | test parse-10.4 {Tcl_EvalTokens, nested commands} testevalex { |
---|
469 | catch {unset a} |
---|
470 | list [catch {testevalex {concat xxx[expr $a]}} msg] $msg |
---|
471 | } {1 {can't read "a": no such variable}} |
---|
472 | test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex { |
---|
473 | set a hello |
---|
474 | testevalex {concat $a} |
---|
475 | } {hello} |
---|
476 | test parse-10.6 {Tcl_EvalTokens, array variables} testevalex { |
---|
477 | catch {unset a} |
---|
478 | set a(12) 46 |
---|
479 | testevalex {concat $a(12)} |
---|
480 | } {46} |
---|
481 | test parse-10.7 {Tcl_EvalTokens, array variables} testevalex { |
---|
482 | catch {unset a} |
---|
483 | set a(12) 46 |
---|
484 | testevalex {concat $a(1[expr 3 - 1])} |
---|
485 | } {46} |
---|
486 | test parse-10.8 {Tcl_EvalTokens, array variables} testevalex { |
---|
487 | catch {unset a} |
---|
488 | list [catch {testevalex {concat $x($a)}} msg] $msg |
---|
489 | } {1 {can't read "a": no such variable}} |
---|
490 | test parse-10.9 {Tcl_EvalTokens, array variables} testevalex { |
---|
491 | catch {unset a} |
---|
492 | list [catch {testevalex {concat xyz$a(1)}} msg] $msg |
---|
493 | } {1 {can't read "a(1)": no such variable}} |
---|
494 | test parse-10.10 {Tcl_EvalTokens, object values} testevalex { |
---|
495 | set a 123 |
---|
496 | testevalex {concat $a} |
---|
497 | } {123} |
---|
498 | test parse-10.11 {Tcl_EvalTokens, object values} testevalex { |
---|
499 | set a 123 |
---|
500 | testevalex {concat $a$a$a} |
---|
501 | } {123123123} |
---|
502 | test parse-10.12 {Tcl_EvalTokens, object values} testevalex { |
---|
503 | testevalex {concat [expr 2][expr 4][expr 6]} |
---|
504 | } {246} |
---|
505 | test parse-10.13 {Tcl_EvalTokens, string values} testevalex { |
---|
506 | testevalex {concat {a" b"}} |
---|
507 | } {a" b"} |
---|
508 | test parse-10.14 {Tcl_EvalTokens, string values} testevalex { |
---|
509 | set a 111 |
---|
510 | testevalex {concat x$a.$a.$a} |
---|
511 | } {x111.111.111} |
---|
512 | |
---|
513 | test parse-11.1 {Tcl_EvalEx, TCL_EVAL_GLOBAL flag} -constraints { |
---|
514 | testevalex |
---|
515 | } -setup { |
---|
516 | proc x {} { |
---|
517 | set y 777 |
---|
518 | set z [testevalex "set y" global] |
---|
519 | return [list $z $y] |
---|
520 | } |
---|
521 | set ::y 321 |
---|
522 | } -cleanup { |
---|
523 | unset ::y |
---|
524 | } -body { |
---|
525 | x |
---|
526 | } -result {321 777} |
---|
527 | test parse-11.2 {Tcl_EvalEx, error while parsing} testevalex { |
---|
528 | list [catch {testevalex {concat "abc}} msg] $msg |
---|
529 | } {1 {missing "}} |
---|
530 | test parse-11.3 {Tcl_EvalEx, error while collecting words} testevalex { |
---|
531 | catch {unset a} |
---|
532 | list [catch {testevalex {concat xyz $a}} msg] $msg |
---|
533 | } {1 {can't read "a": no such variable}} |
---|
534 | test parse-11.4 {Tcl_EvalEx, error in Tcl_EvalObjv call} testevalex { |
---|
535 | catch {unset a} |
---|
536 | list [catch {testevalex {_bogus_ a b c d}} msg] $msg |
---|
537 | } {1 {invalid command name "_bogus_"}} |
---|
538 | test parse-11.5 {Tcl_EvalEx, exceptional return} testevalex { |
---|
539 | list [catch {testevalex {break}} msg] $msg |
---|
540 | } {3 {}} |
---|
541 | test parse-11.6 {Tcl_EvalEx, freeing memory} testevalex { |
---|
542 | testevalex {concat a b c d e f g h i j k l m n o p q r s t u v w x y z} |
---|
543 | } {a b c d e f g h i j k l m n o p q r s t u v w x y z} |
---|
544 | test parse-11.7 {Tcl_EvalEx, multiple commands in script} testevalex { |
---|
545 | list [testevalex {set a b; set c d}] $a $c |
---|
546 | } {d b d} |
---|
547 | test parse-11.8 {Tcl_EvalEx, multiple commands in script} testevalex { |
---|
548 | list [testevalex { |
---|
549 | set a b |
---|
550 | set c d |
---|
551 | }] $a $c |
---|
552 | } {d b d} |
---|
553 | test parse-11.9 {Tcl_EvalEx, freeing memory after error} testevalex { |
---|
554 | catch {unset a} |
---|
555 | list [catch {testevalex {concat a b c d e f g h i j k l m n o p q r s t u v w x y z $a}} msg] $msg |
---|
556 | } {1 {can't read "a": no such variable}} |
---|
557 | test parse-11.10 {Tcl_EvalTokens, empty commands} testevalex { |
---|
558 | testevalex {concat xyz; } |
---|
559 | } {xyz} |
---|
560 | test parse-11.11 {Tcl_EvalTokens, empty commands} testevalex { |
---|
561 | testevalex "concat abc; ; # this is a comment\n" |
---|
562 | } {abc} |
---|
563 | test parse-11.12 {Tcl_EvalTokens, empty commands} testevalex { |
---|
564 | testevalex {} |
---|
565 | } {} |
---|
566 | |
---|
567 | test parse-12.1 {Tcl_ParseVarName procedure, initialization} testparsevarname { |
---|
568 | list [catch {testparsevarname {$a([first second])} 8 0} msg] $msg |
---|
569 | } {1 {missing close-bracket}} |
---|
570 | test parse-12.2 {Tcl_ParseVarName procedure, initialization} testparsevarname { |
---|
571 | testparsevarname {$a([first second])} 0 0 |
---|
572 | } {- {} 0 variable {$a([first second])} 2 text a 0 command {[first second]} 0 {}} |
---|
573 | test parse-12.3 {Tcl_ParseVarName procedure, initialization} testparsevarname { |
---|
574 | list [catch {testparsevarname {$abcd} 3 0} msg] $msg |
---|
575 | } {0 {- {} 0 variable {$ab} 1 text ab 0 cd}} |
---|
576 | test parse-12.4 {Tcl_ParseVarName procedure, initialization} testparsevarname { |
---|
577 | testparsevarname {$abcd} 0 0 |
---|
578 | } {- {} 0 variable {$abcd} 1 text abcd 0 {}} |
---|
579 | test parse-12.5 {Tcl_ParseVarName procedure, just a dollar sign} testparsevarname { |
---|
580 | testparsevarname {$abcd} 1 0 |
---|
581 | } {- {} 0 text {$} 0 abcd} |
---|
582 | test parse-12.6 {Tcl_ParseVarName procedure, braced variable name} testparser { |
---|
583 | testparser {${..[]b}cd} 0 |
---|
584 | } {- {${..[]b}cd} 1 word {${..[]b}cd} 3 variable {${..[]b}} 1 text {..[]b} 0 text cd 0 {}} |
---|
585 | test parse-12.7 {Tcl_ParseVarName procedure, braced variable name} testparser { |
---|
586 | testparser "\$\{\{\} " 0 |
---|
587 | } {- \$\{\{\}\ 1 word \$\{\{\} 2 variable \$\{\{\} 1 text \{ 0 {}} |
---|
588 | test parse-12.8 {Tcl_ParseVarName procedure, missing close brace} testparser { |
---|
589 | list [catch {testparser "$\{abc" 0} msg] $msg $::errorInfo |
---|
590 | } {1 {missing close-brace for variable name} missing\ close-brace\ for\ variable\ name\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\$\\\{abc\"\ 0\"} |
---|
591 | test parse-12.9 {Tcl_ParseVarName procedure, missing close brace} testparsevarname { |
---|
592 | list [catch {testparsevarname {${bcd}} 4 0} msg] $msg |
---|
593 | } {1 {missing close-brace for variable name}} |
---|
594 | test parse-12.10 {Tcl_ParseVarName procedure, missing close brace} testparsevarname { |
---|
595 | list [catch {testparsevarname {${bc}} 4 0} msg] $msg |
---|
596 | } {1 {missing close-brace for variable name}} |
---|
597 | test parse-12.11 {Tcl_ParseVarName procedure, simple variable name} testparser { |
---|
598 | testparser {$az_AZ.} 0 |
---|
599 | } {- {$az_AZ.} 1 word {$az_AZ.} 3 variable {$az_AZ} 1 text az_AZ 0 text . 0 {}} |
---|
600 | test parse-12.12 {Tcl_ParseVarName procedure, simple variable name} testparser { |
---|
601 | testparser {$abcdefg} 4 |
---|
602 | } {- {$abc} 1 word {$abc} 2 variable {$abc} 1 text abc 0 defg} |
---|
603 | test parse-12.13 {Tcl_ParseVarName procedure, simple variable name with ::} testparser { |
---|
604 | testparser {$xyz::ab:c} 0 |
---|
605 | } {- {$xyz::ab:c} 1 word {$xyz::ab:c} 3 variable {$xyz::ab} 1 text xyz::ab 0 text :c 0 {}} |
---|
606 | test parse-12.14 {Tcl_ParseVarName procedure, variable names with many colons} testparser { |
---|
607 | testparser {$xyz:::::c} 0 |
---|
608 | } {- {$xyz:::::c} 1 word {$xyz:::::c} 2 variable {$xyz:::::c} 1 text xyz:::::c 0 {}} |
---|
609 | test parse-12.15 {Tcl_ParseVarName procedure, : vs. ::} testparsevarname { |
---|
610 | testparsevarname {$ab:cd} 0 0 |
---|
611 | } {- {} 0 variable {$ab} 1 text ab 0 :cd} |
---|
612 | test parse-12.16 {Tcl_ParseVarName procedure, eof in ::} testparsevarname { |
---|
613 | testparsevarname {$ab::cd} 4 0 |
---|
614 | } {- {} 0 variable {$ab} 1 text ab 0 ::cd} |
---|
615 | test parse-12.17 {Tcl_ParseVarName procedure, eof in ::} testparsevarname { |
---|
616 | testparsevarname {$ab:::cd} 5 0 |
---|
617 | } {- {} 0 variable {$ab::} 1 text ab:: 0 :cd} |
---|
618 | test parse-12.18 {Tcl_ParseVarName procedure, no variable name} testparser { |
---|
619 | testparser {$$ $.} 0 |
---|
620 | } {- {$$ $.} 2 word {$$} 2 text {$} 0 text {$} 0 word {$.} 2 text {$} 0 text . 0 {}} |
---|
621 | test parse-12.19 {Tcl_ParseVarName procedure, EOF before (} testparsevarname { |
---|
622 | testparsevarname {$ab(cd)} 3 0 |
---|
623 | } {- {} 0 variable {$ab} 1 text ab 0 (cd)} |
---|
624 | test parse-12.20 {Tcl_ParseVarName procedure, array reference} testparser { |
---|
625 | testparser {$x(abc)} 0 |
---|
626 | } {- {$x(abc)} 1 word {$x(abc)} 3 variable {$x(abc)} 2 text x 0 text abc 0 {}} |
---|
627 | test parse-12.21 {Tcl_ParseVarName procedure, array reference} testparser { |
---|
628 | testparser {$x(ab$cde[foo bar])} 0 |
---|
629 | } {- {$x(ab$cde[foo bar])} 1 word {$x(ab$cde[foo bar])} 6 variable {$x(ab$cde[foo bar])} 5 text x 0 text ab 0 variable {$cde} 1 text cde 0 command {[foo bar]} 0 {}} |
---|
630 | test parse-12.22 {Tcl_ParseVarName procedure, array reference} testparser { |
---|
631 | testparser {$x([cmd arg]zz)} 0 |
---|
632 | } {- {$x([cmd arg]zz)} 1 word {$x([cmd arg]zz)} 4 variable {$x([cmd arg]zz)} 3 text x 0 command {[cmd arg]} 0 text zz 0 {}} |
---|
633 | test parse-12.23 {Tcl_ParseVarName procedure, missing close paren in array reference} testparser { |
---|
634 | list [catch {testparser {$x(poiu} 0} msg] $msg $::errorInfo |
---|
635 | } {1 {missing )} {missing ) |
---|
636 | (remainder of script: "(poiu") |
---|
637 | invoked from within |
---|
638 | "testparser {$x(poiu} 0"}} |
---|
639 | test parse-12.24 {Tcl_ParseVarName procedure, missing close paren in array reference} testparsevarname { |
---|
640 | list [catch {testparsevarname {$ab(cd)} 6 0} msg] $msg $::errorInfo |
---|
641 | } {1 {missing )} {missing ) |
---|
642 | (remainder of script: "(cd)") |
---|
643 | invoked from within |
---|
644 | "testparsevarname {$ab(cd)} 6 0"}} |
---|
645 | test parse-12.25 {Tcl_ParseVarName procedure, nested array reference} testparser { |
---|
646 | testparser {$x(a$y(b$z))} 0 |
---|
647 | } {- {$x(a$y(b$z))} 1 word {$x(a$y(b$z))} 8 variable {$x(a$y(b$z))} 7 text x 0 text a 0 variable {$y(b$z)} 4 text y 0 text b 0 variable {$z} 1 text z 0 {}} |
---|
648 | |
---|
649 | test parse-13.1 {Tcl_ParseVar procedure} testparsevar { |
---|
650 | set abc 24 |
---|
651 | testparsevar {$abc.fg} |
---|
652 | } {24 .fg} |
---|
653 | test parse-13.2 {Tcl_ParseVar procedure, no variable name} testparsevar { |
---|
654 | testparsevar {$} |
---|
655 | } {{$} {}} |
---|
656 | test parse-13.3 {Tcl_ParseVar procedure, no variable name} testparsevar { |
---|
657 | testparsevar {$.123} |
---|
658 | } {{$} .123} |
---|
659 | test parse-13.4 {Tcl_ParseVar procedure, error looking up variable} testparsevar { |
---|
660 | catch {unset abc} |
---|
661 | list [catch {testparsevar {$abc}} msg] $msg |
---|
662 | } {1 {can't read "abc": no such variable}} |
---|
663 | test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} testparsevar { |
---|
664 | catch {unset abc} |
---|
665 | list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg |
---|
666 | } {1 {invalid command name "bogus"}} |
---|
667 | |
---|
668 | test parse-14.1 {Tcl_ParseBraces procedure, computing string length} testparser { |
---|
669 | testparser [bytestring "foo\0 bar"] -1 |
---|
670 | } {- foo 1 simple foo 1 text foo 0 {}} |
---|
671 | test parse-14.2 {Tcl_ParseBraces procedure, computing string length} testparser { |
---|
672 | testparser "foo bar" -1 |
---|
673 | } {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} |
---|
674 | test parse-14.3 {Tcl_ParseBraces procedure, words in braces} testparser { |
---|
675 | testparser {foo {a $b [concat foo]} {c d}} 0 |
---|
676 | } {- {foo {a $b [concat foo]} {c d}} 3 simple foo 1 text foo 0 simple {{a $b [concat foo]}} 1 text {a $b [concat foo]} 0 simple {{c d}} 1 text {c d} 0 {}} |
---|
677 | test parse-14.4 {Tcl_ParseBraces procedure, empty nested braces} testparser { |
---|
678 | testparser {foo {{}}} 0 |
---|
679 | } {- {foo {{}}} 2 simple foo 1 text foo 0 simple {{{}}} 1 text {{}} 0 {}} |
---|
680 | test parse-14.5 {Tcl_ParseBraces procedure, nested braces} testparser { |
---|
681 | testparser {foo {{a {b} c} {} {d e}}} 0 |
---|
682 | } {- {foo {{a {b} c} {} {d e}}} 2 simple foo 1 text foo 0 simple {{{a {b} c} {} {d e}}} 1 text {{a {b} c} {} {d e}} 0 {}} |
---|
683 | test parse-14.6 {Tcl_ParseBraces procedure, backslashes in words in braces} testparser { |
---|
684 | testparser "foo {a \\n\\\{}" 0 |
---|
685 | } {- {foo {a \n\{}} 2 simple foo 1 text foo 0 simple {{a \n\{}} 1 text {a \n\{} 0 {}} |
---|
686 | test parse-14.7 {Tcl_ParseBraces procedure, missing continuation line in braces} testparser { |
---|
687 | list [catch {testparser "\{abc\\\n" 0} msg] $msg $::errorInfo |
---|
688 | } {1 {missing close-brace} missing\ close-brace\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\\\n\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\\\{abc\\\\\\n\"\ 0\"} |
---|
689 | test parse-14.8 {Tcl_ParseBraces procedure, backslash-newline in braces} testparser { |
---|
690 | testparser "foo {\\\nx}" 0 |
---|
691 | } {- foo\ \{\\\nx\} 2 simple foo 1 text foo 0 word \{\\\nx\} 2 backslash \\\n 0 text x 0 {}} |
---|
692 | test parse-14.9 {Tcl_ParseBraces procedure, backslash-newline in braces} testparser { |
---|
693 | testparser "foo {a \\\n b}" 0 |
---|
694 | } {- foo\ \{a\ \\\n\ \ \ b\} 2 simple foo 1 text foo 0 word \{a\ \\\n\ \ \ b\} 3 text {a } 0 backslash \\\n\ \ \ 0 text b 0 {}} |
---|
695 | test parse-14.10 {Tcl_ParseBraces procedure, backslash-newline in braces} testparser { |
---|
696 | testparser "foo {xyz\\\n }" 0 |
---|
697 | } {- foo\ \{xyz\\\n\ \} 2 simple foo 1 text foo 0 word \{xyz\\\n\ \} 2 text xyz 0 backslash \\\n\ 0 {}} |
---|
698 | test parse-14.11 {Tcl_ParseBraces procedure, empty braced string} testparser { |
---|
699 | testparser {foo {}} 0 |
---|
700 | } {- {foo {}} 2 simple foo 1 text foo 0 simple {{}} 1 text {} 0 {}} |
---|
701 | test parse-14.12 {Tcl_ParseBraces procedure, missing close brace} testparser { |
---|
702 | list [catch {testparser "foo \{xy\\\nz" 0} msg] $msg $::errorInfo |
---|
703 | } {1 {missing close-brace} missing\ close-brace\n\ \ \ \ (remainder\ of\ script:\ \"\{xy\\\nz\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"foo\ \\\{xy\\\\\\nz\"\ 0\"} |
---|
704 | |
---|
705 | test parse-15.1 {Tcl_ParseQuotedString procedure, computing string length} testparser { |
---|
706 | testparser [bytestring "foo\0 bar"] -1 |
---|
707 | } {- foo 1 simple foo 1 text foo 0 {}} |
---|
708 | test parse-15.2 {Tcl_ParseQuotedString procedure, computing string length} testparser { |
---|
709 | testparser "foo bar" -1 |
---|
710 | } {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}} |
---|
711 | test parse-15.3 {Tcl_ParseQuotedString procedure, word is quoted string} testparser { |
---|
712 | testparser {foo "a b c" d "efg";} 0 |
---|
713 | } {- {foo "a b c" d "efg";} 4 simple foo 1 text foo 0 simple {"a b c"} 1 text {a b c} 0 simple d 1 text d 0 simple {"efg"} 1 text efg 0 {}} |
---|
714 | test parse-15.4 {Tcl_ParseQuotedString procedure, garbage after quoted string} testparser { |
---|
715 | list [catch {testparser {foo "a b c"d} 0} msg] $msg $::errorInfo |
---|
716 | } {1 {extra characters after close-quote} {extra characters after close-quote |
---|
717 | (remainder of script: "d") |
---|
718 | invoked from within |
---|
719 | "testparser {foo "a b c"d} 0"}} |
---|
720 | |
---|
721 | test parse-15.5 {CommandComplete procedure} { |
---|
722 | info complete "" |
---|
723 | } 1 |
---|
724 | test parse-15.6 {CommandComplete procedure} { |
---|
725 | info complete " \n" |
---|
726 | } 1 |
---|
727 | test parse-15.7 {CommandComplete procedure} { |
---|
728 | info complete "abc def" |
---|
729 | } 1 |
---|
730 | test parse-15.8 {CommandComplete procedure} { |
---|
731 | info complete "a b c d e f \t\n" |
---|
732 | } 1 |
---|
733 | test parse-15.9 {CommandComplete procedure} { |
---|
734 | info complete {a b c"d} |
---|
735 | } 1 |
---|
736 | test parse-15.10 {CommandComplete procedure} { |
---|
737 | info complete {a b "c d" e} |
---|
738 | } 1 |
---|
739 | test parse-15.11 {CommandComplete procedure} { |
---|
740 | info complete {a b "c d"} |
---|
741 | } 1 |
---|
742 | test parse-15.12 {CommandComplete procedure} { |
---|
743 | info complete {a b "c d"} |
---|
744 | } 1 |
---|
745 | test parse-15.13 {CommandComplete procedure} { |
---|
746 | info complete {a b "c d} |
---|
747 | } 0 |
---|
748 | test parse-15.14 {CommandComplete procedure} { |
---|
749 | info complete {a b "} |
---|
750 | } 0 |
---|
751 | test parse-15.15 {CommandComplete procedure} { |
---|
752 | info complete {a b "cd"xyz} |
---|
753 | } 1 |
---|
754 | test parse-15.16 {CommandComplete procedure} { |
---|
755 | info complete {a b "c $d() d"} |
---|
756 | } 1 |
---|
757 | test parse-15.17 {CommandComplete procedure} { |
---|
758 | info complete {a b "c $dd("} |
---|
759 | } 0 |
---|
760 | test parse-15.18 {CommandComplete procedure} { |
---|
761 | info complete {a b "c \"} |
---|
762 | } 0 |
---|
763 | test parse-15.19 {CommandComplete procedure} { |
---|
764 | info complete {a b "c [d e f]"} |
---|
765 | } 1 |
---|
766 | test parse-15.20 {CommandComplete procedure} { |
---|
767 | info complete {a b "c [d e f] g"} |
---|
768 | } 1 |
---|
769 | test parse-15.21 {CommandComplete procedure} { |
---|
770 | info complete {a b "c [d e f"} |
---|
771 | } 0 |
---|
772 | test parse-15.22 {CommandComplete procedure} { |
---|
773 | info complete {a {b c d} e} |
---|
774 | } 1 |
---|
775 | test parse-15.23 {CommandComplete procedure} { |
---|
776 | info complete {a {b c d}} |
---|
777 | } 1 |
---|
778 | test parse-15.24 {CommandComplete procedure} { |
---|
779 | info complete "a b\{c d" |
---|
780 | } 1 |
---|
781 | test parse-15.25 {CommandComplete procedure} { |
---|
782 | info complete "a b \{c" |
---|
783 | } 0 |
---|
784 | test parse-15.26 {CommandComplete procedure} { |
---|
785 | info complete "a b \{c{ }" |
---|
786 | } 0 |
---|
787 | test parse-15.27 {CommandComplete procedure} { |
---|
788 | info complete "a b {c d e}xxx" |
---|
789 | } 1 |
---|
790 | test parse-15.28 {CommandComplete procedure} { |
---|
791 | info complete "a b {c \\\{d e}xxx" |
---|
792 | } 1 |
---|
793 | test parse-15.29 {CommandComplete procedure} { |
---|
794 | info complete {a b [ab cd ef]} |
---|
795 | } 1 |
---|
796 | test parse-15.30 {CommandComplete procedure} { |
---|
797 | info complete {a b x[ab][cd][ef] gh} |
---|
798 | } 1 |
---|
799 | test parse-15.31 {CommandComplete procedure} { |
---|
800 | info complete {a b x[ab][cd[ef] gh} |
---|
801 | } 0 |
---|
802 | test parse-15.32 {CommandComplete procedure} { |
---|
803 | info complete {a b x[ gh} |
---|
804 | } 0 |
---|
805 | test parse-15.33 {CommandComplete procedure} { |
---|
806 | info complete {[]]]} |
---|
807 | } 1 |
---|
808 | test parse-15.34 {CommandComplete procedure} { |
---|
809 | info complete {abc x$yyy} |
---|
810 | } 1 |
---|
811 | test parse-15.35 {CommandComplete procedure} { |
---|
812 | info complete "abc x\${abc\[\\d} xyz" |
---|
813 | } 1 |
---|
814 | test parse-15.36 {CommandComplete procedure} { |
---|
815 | info complete "abc x\$\{ xyz" |
---|
816 | } 0 |
---|
817 | test parse-15.37 {CommandComplete procedure} { |
---|
818 | info complete {word $a(xyz)} |
---|
819 | } 1 |
---|
820 | test parse-15.38 {CommandComplete procedure} { |
---|
821 | info complete {word $a(} |
---|
822 | } 0 |
---|
823 | test parse-15.39 {CommandComplete procedure} { |
---|
824 | info complete "set a \\\n" |
---|
825 | } 0 |
---|
826 | test parse-15.40 {CommandComplete procedure} { |
---|
827 | info complete "set a \\\\\n" |
---|
828 | } 1 |
---|
829 | test parse-15.41 {CommandComplete procedure} { |
---|
830 | info complete "set a \\n " |
---|
831 | } 1 |
---|
832 | test parse-15.42 {CommandComplete procedure} { |
---|
833 | info complete "set a \\" |
---|
834 | } 1 |
---|
835 | test parse-15.43 {CommandComplete procedure} { |
---|
836 | info complete "foo \\\n\{" |
---|
837 | } 0 |
---|
838 | test parse-15.44 {CommandComplete procedure} { |
---|
839 | info complete "a\nb\n# \{\n# \{\nc\n" |
---|
840 | } 1 |
---|
841 | test parse-15.45 {CommandComplete procedure} { |
---|
842 | info complete "#Incomplete comment\\\n" |
---|
843 | } 0 |
---|
844 | test parse-15.46 {CommandComplete procedure} { |
---|
845 | info complete "#Incomplete comment\\\nBut now it's complete.\n" |
---|
846 | } 1 |
---|
847 | test parse-15.47 {CommandComplete procedure} { |
---|
848 | info complete "# Complete comment\\\\\n" |
---|
849 | } 1 |
---|
850 | test parse-15.48 {CommandComplete procedure} { |
---|
851 | info complete "abc\\\n def" |
---|
852 | } 1 |
---|
853 | test parse-15.49 {CommandComplete procedure} { |
---|
854 | info complete "abc\\\n " |
---|
855 | } 1 |
---|
856 | test parse-15.50 {CommandComplete procedure} { |
---|
857 | info complete "abc\\\n" |
---|
858 | } 0 |
---|
859 | test parse-15.51 {CommandComplete procedure} " |
---|
860 | info complete \"\\\{abc\\\}\\\{\" |
---|
861 | " 1 |
---|
862 | test parse-15.52 {CommandComplete procedure} { |
---|
863 | info complete "\"abc\"(" |
---|
864 | } 1 |
---|
865 | test parse-15.53 {CommandComplete procedure} " |
---|
866 | info complete \" # \{\" |
---|
867 | " 1 |
---|
868 | test parse-15.54 {CommandComplete procedure} " |
---|
869 | info complete \"foo bar;# \{\" |
---|
870 | " 1 |
---|
871 | test parse-15.55 {CommandComplete procedure} { |
---|
872 | info complete "set x [bytestring \0]; puts hi" |
---|
873 | } 1 |
---|
874 | test parse-15.56 {CommandComplete procedure} { |
---|
875 | info complete "set x [bytestring \0]; \{" |
---|
876 | } 0 |
---|
877 | test parse-15.57 {CommandComplete procedure} { |
---|
878 | info complete "# Comment should be complete command" |
---|
879 | } 1 |
---|
880 | test parse-15.58 {CommandComplete procedure, memory leaks} { |
---|
881 | info complete "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22" |
---|
882 | } 1 |
---|
883 | test parse-15.59 {CommandComplete procedure} { |
---|
884 | # Test for Tcl Bug 684744 |
---|
885 | info complete [encoding convertfrom identity "\x00;if 1 \{"] |
---|
886 | } 0 |
---|
887 | |
---|
888 | test parse-16.1 {Tcl_EvalEx, check termOffset is set correctly for non TCL_OK cases, bug 2535} { |
---|
889 | subst {[eval {return foo}]bar} |
---|
890 | } foobar |
---|
891 | |
---|
892 | test parse-17.1 {Correct return codes from errors during substitution} { |
---|
893 | catch {eval {w[continue]}} |
---|
894 | } 4 |
---|
895 | |
---|
896 | test parse-18.1 {Tcl_SubstObj, ParseTokens flags} { |
---|
897 | subst {foo\t$::tcl_library\t[set ::tcl_library]} |
---|
898 | } "foo $::tcl_library $::tcl_library" |
---|
899 | test parse-18.2 {Tcl_SubstObj, ParseTokens flags} { |
---|
900 | subst -nocommands {foo\t$::tcl_library\t[set ::tcl_library]} |
---|
901 | } "foo $::tcl_library \[set ::tcl_library]" |
---|
902 | test parse-18.3 {Tcl_SubstObj, ParseTokens flags} { |
---|
903 | subst -novariables {foo\t$::tcl_library\t[set ::tcl_library]} |
---|
904 | } "foo \$::tcl_library $::tcl_library" |
---|
905 | test parse-18.4 {Tcl_SubstObj, ParseTokens flags} { |
---|
906 | subst -nobackslashes {foo\t$::tcl_library\t[set ::tcl_library]} |
---|
907 | } "foo\\t$::tcl_library\\t$::tcl_library" |
---|
908 | test parse-18.5 {Tcl_SubstObj, ParseTokens flags} { |
---|
909 | subst -novariables -nobackslashes {foo\t$::tcl_library\t[set ::tcl_library]} |
---|
910 | } "foo\\t\$::tcl_library\\t$::tcl_library" |
---|
911 | test parse-18.6 {Tcl_SubstObj, ParseTokens flags} { |
---|
912 | subst -nocommands -nobackslashes {foo\t$::tcl_library\t[set ::tcl_library]} |
---|
913 | } "foo\\t$::tcl_library\\t\[set ::tcl_library]" |
---|
914 | test parse-18.7 {Tcl_SubstObj, ParseTokens flags} { |
---|
915 | subst -nocommands -novariables {foo\t$::tcl_library\t[set ::tcl_library]} |
---|
916 | } "foo \$::tcl_library \[set ::tcl_library]" |
---|
917 | test parse-18.8 {Tcl_SubstObj, ParseTokens flags} { |
---|
918 | subst -nocommands -novariables -nobackslashes \ |
---|
919 | {foo\t$::tcl_library\t[set ::tcl_library]} |
---|
920 | } "foo\\t\$::tcl_library\\t\[set ::tcl_library]" |
---|
921 | |
---|
922 | test parse-18.9 {Tcl_SubstObj, parse errors} { |
---|
923 | list [catch "subst foo\$\{foo" msg] $msg |
---|
924 | } [list 1 "missing close-brace for variable name"] |
---|
925 | test parse-18.10 {Tcl_SubstObj, parse errors} { |
---|
926 | list [catch "subst foo\[set \$\{foo]" msg] $msg |
---|
927 | } [list 1 "missing close-brace for variable name"] |
---|
928 | test parse-18.11 {Tcl_SubstObj, parse errors} { |
---|
929 | list [catch "subst foo\$array(\$\{foo)" msg] $msg |
---|
930 | } [list 1 "missing close-brace for variable name"] |
---|
931 | test parse-18.12 {Tcl_SubstObj, parse errors} { |
---|
932 | list [catch "subst foo\$(\$\{foo)" msg] $msg |
---|
933 | } [list 1 "missing close-brace for variable name"] |
---|
934 | test parse-18.13 {Tcl_SubstObj, parse errors} { |
---|
935 | list [catch "subst \[" msg] $msg |
---|
936 | } [list 1 "missing close-bracket"] |
---|
937 | |
---|
938 | test parse-18.14 {Tcl_SubstObj, exception handling} { |
---|
939 | subst {abc,[break],def} |
---|
940 | } {abc,} |
---|
941 | test parse-18.15 {Tcl_SubstObj, exception handling} { |
---|
942 | subst {abc,[continue; expr 1+2],def} |
---|
943 | } {abc,,def} |
---|
944 | test parse-18.16 {Tcl_SubstObj, exception handling} { |
---|
945 | subst {abc,[return foo; expr 1+2],def} |
---|
946 | } {abc,foo,def} |
---|
947 | test parse-18.17 {Tcl_SubstObj, exception handling} { |
---|
948 | subst {abc,[return -code 10 foo; expr 1+2],def} |
---|
949 | } {abc,foo,def} |
---|
950 | test parse-18.18 {Tcl_SubstObj, exception handling} { |
---|
951 | subst {abc,[break; set {} {}{}],def} |
---|
952 | } {abc,} |
---|
953 | test parse-18.19 {Tcl_SubstObj, exception handling} { |
---|
954 | list [catch {subst {abc,[continue; expr 1+2; set {} {}{}],def}} msg] $msg |
---|
955 | } [list 1 "extra characters after close-brace"] |
---|
956 | test parse-18.20 {Tcl_SubstObj, exception handling} { |
---|
957 | list [catch {subst {abc,[return foo; expr 1+2; set {} {}{}],def}} msg] $msg |
---|
958 | } [list 1 "extra characters after close-brace"] |
---|
959 | test parse-18.21 {Tcl_SubstObj, exception handling} { |
---|
960 | list [catch { |
---|
961 | subst {abc,[return -code 10 foo; expr 1+2; set {} {}{}],def} |
---|
962 | } msg] $msg |
---|
963 | } [list 1 "extra characters after close-brace"] |
---|
964 | |
---|
965 | test parse-18.22 {Tcl_SubstObj, side effects} { |
---|
966 | set a 0 |
---|
967 | list [subst {foo[incr a]bar}] $a |
---|
968 | } [list foo1bar 1] |
---|
969 | test parse-18.23 {Tcl_SubstObj, side effects} { |
---|
970 | set a 0 |
---|
971 | list [subst {foo[incr a; incr a]bar}] $a |
---|
972 | } [list foo2bar 2] |
---|
973 | test parse-18.24 {Tcl_SubstObj, side effects} { |
---|
974 | set a 0 |
---|
975 | list [subst {foo[incr a; break; incr a]bar}] $a |
---|
976 | } [list foo 1] |
---|
977 | test parse-18.25 {Tcl_SubstObj, side effects} { |
---|
978 | set a 0 |
---|
979 | list [subst {foo[incr a; continue; incr a]bar}] $a |
---|
980 | } [list foobar 1] |
---|
981 | test parse-18.26 {Tcl_SubstObj, side effects} { |
---|
982 | set a 0 |
---|
983 | list [subst {foo[incr a; return; incr a]bar}] $a |
---|
984 | } [list foobar 1] |
---|
985 | test parse-18.27 {Tcl_SubstObj, side effects} { |
---|
986 | set a 0 |
---|
987 | list [subst {foo[incr a; return -code 10; incr a]bar}] $a |
---|
988 | } [list foobar 1] |
---|
989 | test parse-18.28 {Tcl_SubstObj, side effects} { |
---|
990 | set a 0 |
---|
991 | catch {subst {foo[incr a; parse error {}{}; incr a]bar}} |
---|
992 | set a |
---|
993 | } 1 |
---|
994 | test parse-18.29 {Tcl_SubstObj, side effects} { |
---|
995 | set a 0 |
---|
996 | catch {subst {foo[incr a; incr a; parse error {}{}]bar}} |
---|
997 | set a |
---|
998 | } 2 |
---|
999 | test parse-18.30 {Tcl_SubstObj, side effects} { |
---|
1000 | set a 0 |
---|
1001 | catch {subst {foo[incr a; incr a parse error {}{}]bar}} |
---|
1002 | set a |
---|
1003 | } 1 |
---|
1004 | |
---|
1005 | test parse-19.1 {Bug 1115904: recursion limit in Tcl_EvalEx} -constraints { |
---|
1006 | testevalex |
---|
1007 | } -setup { |
---|
1008 | interp create i |
---|
1009 | load {} Tcltest i |
---|
1010 | i eval {proc {} args {}} |
---|
1011 | interp recursionlimit i 3 |
---|
1012 | } -body { |
---|
1013 | i eval {testevalex {[]}} |
---|
1014 | } -cleanup { |
---|
1015 | interp delete i |
---|
1016 | } |
---|
1017 | |
---|
1018 | test parse-19.2 {Bug 1115904: recursion limit in Tcl_EvalEx} -constraints { |
---|
1019 | testevalex |
---|
1020 | } -setup { |
---|
1021 | interp create i |
---|
1022 | load {} Tcltest i |
---|
1023 | i eval {proc {} args {}} |
---|
1024 | interp recursionlimit i 3 |
---|
1025 | } -body { |
---|
1026 | i eval {testevalex {[[]]}} |
---|
1027 | } -cleanup { |
---|
1028 | interp delete i |
---|
1029 | } -returnCodes error -match glob -result {too many nested*} |
---|
1030 | |
---|
1031 | test parse-19.3 {Bug 1115904: recursion limit in Tcl_EvalEx} -setup { |
---|
1032 | interp create i |
---|
1033 | i eval {proc {} args {}} |
---|
1034 | interp recursionlimit i 3 |
---|
1035 | } -body { |
---|
1036 | i eval {subst {[]}} |
---|
1037 | } -cleanup { |
---|
1038 | interp delete i |
---|
1039 | } |
---|
1040 | |
---|
1041 | test parse-19.4 {Bug 1115904: recursion limit in Tcl_EvalEx} -setup { |
---|
1042 | interp create i |
---|
1043 | i eval {proc {} args {}} |
---|
1044 | interp recursionlimit i 3 |
---|
1045 | } -body { |
---|
1046 | i eval {subst {[[]]}} |
---|
1047 | } -cleanup { |
---|
1048 | interp delete i |
---|
1049 | } -returnCodes error -match glob -result {too many nested*} |
---|
1050 | |
---|
1051 | cleanupTests |
---|
1052 | } |
---|
1053 | |
---|
1054 | namespace delete ::tcl::test::parse |
---|
1055 | return |
---|