Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: downloads/tcl8.5.2/tests/parse.test @ 47

Last change on this file since 47 was 25, checked in by landauf, 17 years ago

added tcl to libs

File size: 44.1 KB
Line 
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
13if {[catch {package require tcltest 2.0.2}]} {
14    puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
15    return
16}
17
18namespace eval ::tcl::test::parse {
19    namespace import ::tcltest::*
20
21testConstraint testparser [llength [info commands testparser]]
22testConstraint testevalobjv [llength [info commands testevalobjv]]
23testConstraint testevalex [llength [info commands testevalex]]
24testConstraint testparsevarname [llength [info commands testparsevarname]]
25testConstraint testparsevar [llength [info commands testparsevar]]
26testConstraint testasync [llength [info commands testasync]]
27testConstraint testcmdtrace [llength [info commands testcmdtrace]]
28
29test 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 {}}
32test 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 {}}
35test parse-1.3 {Tcl_ParseCommand procedure, leading space} testparser {
36    testparser "  \n\t   foo" 0
37} {- foo 1 simple foo 1 text foo 0 {}}
38test parse-1.4 {Tcl_ParseCommand procedure, leading space} testparser {
39    testparser "\f\r\vfoo" 0
40} {- foo 1 simple foo 1 text foo 0 {}}
41test 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 {}}
44test 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 {}}
47test parse-1.7 {Tcl_ParseCommand procedure, missing continuation line in leading space} testparser {
48    testparser "   \\\n" 0
49} {- {} 0 {}}
50test parse-1.8 {Tcl_ParseCommand procedure, eof in leading space} testparser {
51    testparser "      foo" 3
52} {- {} 0 {   foo}}
53test 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}
56test 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
60test 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 {}}
64test 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 {}}
69test 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 {}}
72test parse-2.4 {Tcl_ParseCommand procedure, missing continuation line in comment} testparser {
73    testparser "#   \\\n" 0
74} {\#\ \ \ \\\n {} 0 {}}
75test parse-2.5 {Tcl_ParseCommand procedure, eof in comment} testparser {
76    testparser " # foo bar\nfoo" 8
77} {{# foo b} {} 0 {ar
78foo}}
79
80test 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 {}}
83test 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 {}}
86test 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}}
89test 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 {     }}
92test 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 {}}
95test 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 {}}
98test 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
102test parse-4.1 {Tcl_ParseCommand procedure, simple words} testparser {
103    testparser {foo} 0
104} {- foo 1 simple foo 1 text foo 0 {}}
105test parse-4.2 {Tcl_ParseCommand procedure, simple words} testparser {
106    testparser {{abc}} 0
107} {- {{abc}} 1 simple {{abc}} 1 text abc 0 {}}
108test 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 {}}
111test 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 {}}
114test 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 {}}
117test 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
121test 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 {}}
124test 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 {}}
127test 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}}
131test 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}}
134test 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}}
137test 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"}}
143test 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 {}}
146test 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"}}
152test 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 {}}
155test 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
163test parse-5.11 {Tcl_ParseCommand: {*} parsing} testparser {
164    testparser {{expan}} 0
165} {- {{expan}} 1 simple {{expan}} 1 text expan 0 {}}
166test 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}
171test parse-5.13 {Tcl_ParseCommand: {*} parsing} testparser {
172    testparser {{**}} 0
173} {- {{**}} 1 simple {{**}} 1 text ** 0 {}}
174test parse-5.14 {Tcl_ParseCommand: {*} parsing} -constraints {
175    testparser
176} -body {
177    testparser {{**}x} 0
178} -returnCodes error  -result {extra characters after close-brace}
179test 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}
184test parse-5.16 {Tcl_ParseCommand: {*} parsing} testparser {
185    testparser {{123456\
186                        }} 0
187} {- {{123456 }} 1 simple {{123456 }} 1 text {123456 } 0 {}}
188test 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}
194test parse-5.18 {Tcl_ParseCommand: {*} parsing} testparser {
195    testparser {{*\
196                        }} 0
197} {- {{* }} 1 simple {{* }} 1 text {* } 0 {}}
198test 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}
204test parse-5.20 {Tcl_ParseCommand: {*} parsing} testparser {
205    testparser {{123456}} 0
206} {- {{123456}} 1 simple {{123456}} 1 text 123456 0 {}}
207test 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}
212test parse-5.22 {Tcl_ParseCommand: {*} parsing} testparser {
213    testparser {{*}} 0
214} {- {{*}} 1 simple {{*}} 1 text * 0 {}}
215test parse-5.23 {Tcl_ParseCommand: {*} parsing} testparser {
216    testparser {{*} } 0
217} {- {{*} } 1 simple {{*}} 1 text * 0 {}}
218test parse-5.24 {Tcl_ParseCommand: {*} parsing} testparser {
219    testparser {{*}x} 0
220} {- {{*}x} 1 simple x 1 text x 0 {}}
221test parse-5.25 {Tcl_ParseCommand: {*} parsing} testparser {
222    testparser {{*}
223} 0
224} {- {{*}
225} 1 simple {{*}} 1 text * 0 {}}
226test parse-5.26 {Tcl_ParseCommand: {*} parsing} testparser {
227    testparser {{*};} 0
228} {- {{*};} 1 simple {{*}} 1 text * 0 {}}
229test 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
233test parse-6.1 {ParseTokens procedure, empty word} testparser {
234    testparser {""} 0
235} {- {""} 1 simple {""} 1 text {} 0 {}}
236test 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 {}}
239test 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 {}}
242test parse-6.4 {ParseTokens procedure, variable reference} testparser {
243    list [catch {testparser {$x([a )} 0} msg] $msg
244} {1 {missing close-bracket}}
245test 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 {}}
248test 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 {}}
251test 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"}}
257test parse-6.8 {ParseTokens procedure, error in command substitution} {
258    info complete {a [b {}c d]}
259} {1}
260test parse-6.9 {ParseTokens procedure, error in command substitution} {
261    info complete {a [b "c d}
262} {0}
263test parse-6.10 {ParseTokens procedure, incomplete sub-command} {
264    info complete {puts [
265        expr 1+1
266        #this is a comment ]}
267} {0}
268test 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 {}}
271test 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"}}
277test 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\"}
280test 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 {}}
283test 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 {}}
286test 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 {}}
289test 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 {}"
292test 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
297test 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
301test parse-8.1 {Tcl_EvalObjv procedure} testevalobjv {
302    testevalobjv 0 concat this is a test
303} {this is a test}
304test 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"}}
310test 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}}
320test 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}}
330test 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}}
334test 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}
348test 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}
368test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} testevalobjv {
369    list [catch {testevalobjv 0 error message} msg] $msg
370} {1 message}
371test 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}
385test 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}]
405test 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
427test 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    }}"}}
453test 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
459test parse-10.1 {Tcl_EvalTokens, simple text} testevalex {
460    testevalex {concat test}
461} {test}
462test parse-10.2 {Tcl_EvalTokens, backslash sequences} testevalex {
463    testevalex {concat test\063\062test}
464} {test32test}
465test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex {
466    testevalex {concat [expr 2 + 6]}
467} {8}
468test 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}}
472test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex {
473    set a hello
474    testevalex {concat $a}
475} {hello}
476test parse-10.6 {Tcl_EvalTokens, array variables} testevalex {
477    catch {unset a}
478    set a(12) 46
479    testevalex {concat $a(12)}
480} {46}
481test 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}
486test 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}}
490test 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}}
494test parse-10.10 {Tcl_EvalTokens, object values} testevalex {
495    set a 123
496    testevalex {concat $a}
497} {123}
498test parse-10.11 {Tcl_EvalTokens, object values} testevalex {
499    set a 123
500    testevalex {concat $a$a$a}
501} {123123123}
502test parse-10.12 {Tcl_EvalTokens, object values} testevalex {
503    testevalex {concat [expr 2][expr 4][expr 6]}
504} {246}
505test parse-10.13 {Tcl_EvalTokens, string values} testevalex {
506    testevalex {concat {a" b"}}
507} {a" b"}
508test parse-10.14 {Tcl_EvalTokens, string values} testevalex {
509    set a 111
510    testevalex {concat x$a.$a.$a}
511} {x111.111.111}
512
513test 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}
527test parse-11.2 {Tcl_EvalEx, error while parsing} testevalex {
528    list [catch {testevalex {concat "abc}} msg] $msg
529} {1 {missing "}}
530test 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}}
534test 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_"}}
538test parse-11.5 {Tcl_EvalEx, exceptional return} testevalex {
539    list [catch {testevalex {break}} msg] $msg
540} {3 {}}
541test 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}
544test 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}
547test 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}
553test 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}}
557test parse-11.10 {Tcl_EvalTokens, empty commands} testevalex {
558    testevalex {concat xyz;   }
559} {xyz}
560test parse-11.11 {Tcl_EvalTokens, empty commands} testevalex {
561    testevalex "concat abc; ; # this is a comment\n"
562} {abc}
563test parse-11.12 {Tcl_EvalTokens, empty commands} testevalex {
564    testevalex {}
565} {}
566
567test parse-12.1 {Tcl_ParseVarName procedure, initialization} testparsevarname {
568    list [catch {testparsevarname {$a([first second])} 8 0} msg] $msg
569} {1 {missing close-bracket}}
570test 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 {}}
573test 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}}
576test parse-12.4 {Tcl_ParseVarName procedure, initialization} testparsevarname {
577    testparsevarname {$abcd} 0 0
578} {- {} 0 variable {$abcd} 1 text abcd 0 {}}
579test parse-12.5 {Tcl_ParseVarName procedure, just a dollar sign} testparsevarname {
580    testparsevarname {$abcd} 1 0
581} {- {} 0 text {$} 0 abcd}
582test 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 {}}
585test parse-12.7 {Tcl_ParseVarName procedure, braced variable name} testparser {
586    testparser "\$\{\{\} " 0
587} {- \$\{\{\}\  1 word \$\{\{\} 2 variable \$\{\{\} 1 text \{ 0 {}}
588test 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\"}
591test 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}}
594test 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}}
597test 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 {}}
600test 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}
603test 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 {}}
606test 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 {}}
609test parse-12.15 {Tcl_ParseVarName procedure, : vs. ::} testparsevarname {
610    testparsevarname {$ab:cd} 0 0
611} {- {} 0 variable {$ab} 1 text ab 0 :cd}
612test parse-12.16 {Tcl_ParseVarName procedure, eof in ::} testparsevarname {
613    testparsevarname {$ab::cd} 4 0
614} {- {} 0 variable {$ab} 1 text ab 0 ::cd}
615test parse-12.17 {Tcl_ParseVarName procedure, eof in ::} testparsevarname {
616    testparsevarname {$ab:::cd} 5 0
617} {- {} 0 variable {$ab::} 1 text ab:: 0 :cd}
618test 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 {}}
621test parse-12.19 {Tcl_ParseVarName procedure, EOF before (} testparsevarname {
622    testparsevarname {$ab(cd)} 3 0
623} {- {} 0 variable {$ab} 1 text ab 0 (cd)}
624test 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 {}}
627test 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 {}}
630test 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 {}}
633test 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"}}
639test 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"}}
645test 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
649test parse-13.1 {Tcl_ParseVar procedure} testparsevar {
650    set abc 24
651    testparsevar {$abc.fg}
652} {24 .fg}
653test parse-13.2 {Tcl_ParseVar procedure, no variable name} testparsevar {
654    testparsevar {$}
655} {{$} {}}
656test parse-13.3 {Tcl_ParseVar procedure, no variable name} testparsevar {
657    testparsevar {$.123}
658} {{$} .123}
659test 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}}
663test 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
668test 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 {}}
671test 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 {}}
674test 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 {}}
677test 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 {}}
680test 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 {}}
683test 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 {}}
686test 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\"}
689test 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 {}}
692test 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 {}}
695test 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 {}}
698test 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 {}}
701test 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
705test 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 {}}
708test 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 {}}
711test 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 {}}
714test 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
721test parse-15.5 {CommandComplete procedure} {
722    info complete ""
723} 1
724test parse-15.6 {CommandComplete procedure} {
725    info complete "  \n"
726} 1
727test parse-15.7 {CommandComplete procedure} {
728    info complete "abc def"
729} 1
730test parse-15.8 {CommandComplete procedure} {
731    info complete "a b c d e f \t\n"
732} 1
733test parse-15.9 {CommandComplete procedure} {
734    info complete {a b c"d}
735} 1
736test parse-15.10 {CommandComplete procedure} {
737    info complete {a b "c d" e}
738} 1
739test parse-15.11 {CommandComplete procedure} {
740    info complete {a b "c d"}
741} 1
742test parse-15.12 {CommandComplete procedure} {
743    info complete {a b "c d"}
744} 1
745test parse-15.13 {CommandComplete procedure} {
746    info complete {a b "c d}
747} 0
748test parse-15.14 {CommandComplete procedure} {
749    info complete {a b "}
750} 0
751test parse-15.15 {CommandComplete procedure} {
752    info complete {a b "cd"xyz}
753} 1
754test parse-15.16 {CommandComplete procedure} {
755    info complete {a b "c $d() d"}
756} 1
757test parse-15.17 {CommandComplete procedure} {
758    info complete {a b "c $dd("}
759} 0
760test parse-15.18 {CommandComplete procedure} {
761    info complete {a b "c \"}
762} 0
763test parse-15.19 {CommandComplete procedure} {
764    info complete {a b "c [d e f]"}
765} 1
766test parse-15.20 {CommandComplete procedure} {
767    info complete {a b "c [d e f] g"}
768} 1
769test parse-15.21 {CommandComplete procedure} {
770    info complete {a b "c [d e f"}
771} 0
772test parse-15.22 {CommandComplete procedure} {
773    info complete {a {b c d} e}
774} 1
775test parse-15.23 {CommandComplete procedure} {
776    info complete {a {b c d}}
777} 1
778test parse-15.24 {CommandComplete procedure} {
779    info complete "a b\{c d"
780} 1
781test parse-15.25 {CommandComplete procedure} {
782    info complete "a b \{c"
783} 0
784test parse-15.26 {CommandComplete procedure} {
785    info complete "a b \{c{ }"
786} 0
787test parse-15.27 {CommandComplete procedure} {
788    info complete "a b {c d e}xxx"
789} 1
790test parse-15.28 {CommandComplete procedure} {
791    info complete "a b {c \\\{d e}xxx"
792} 1
793test parse-15.29 {CommandComplete procedure} {
794    info complete {a b [ab cd ef]}
795} 1
796test parse-15.30 {CommandComplete procedure} {
797    info complete {a b x[ab][cd][ef] gh}
798} 1
799test parse-15.31 {CommandComplete procedure} {
800    info complete {a b x[ab][cd[ef] gh}
801} 0
802test parse-15.32 {CommandComplete procedure} {
803    info complete {a b x[ gh}
804} 0
805test parse-15.33 {CommandComplete procedure} {
806    info complete {[]]]}
807} 1
808test parse-15.34 {CommandComplete procedure} {
809    info complete {abc x$yyy}
810} 1
811test parse-15.35 {CommandComplete procedure} {
812    info complete "abc x\${abc\[\\d} xyz"
813} 1
814test parse-15.36 {CommandComplete procedure} {
815    info complete "abc x\$\{ xyz"
816} 0
817test parse-15.37 {CommandComplete procedure} {
818    info complete {word $a(xyz)}
819} 1
820test parse-15.38 {CommandComplete procedure} {
821    info complete {word $a(}
822} 0
823test parse-15.39 {CommandComplete procedure} {
824    info complete "set a \\\n"
825} 0
826test parse-15.40 {CommandComplete procedure} {
827    info complete "set a \\\\\n"
828} 1
829test parse-15.41 {CommandComplete procedure} {
830    info complete "set a \\n "
831} 1
832test parse-15.42 {CommandComplete procedure} {
833    info complete "set a \\"
834} 1
835test parse-15.43 {CommandComplete procedure} {
836    info complete "foo \\\n\{"
837} 0
838test parse-15.44 {CommandComplete procedure} {
839    info complete "a\nb\n# \{\n# \{\nc\n"
840} 1
841test parse-15.45 {CommandComplete procedure} {
842    info complete "#Incomplete comment\\\n"
843} 0
844test parse-15.46 {CommandComplete procedure} {
845    info complete "#Incomplete comment\\\nBut now it's complete.\n"
846} 1
847test parse-15.47 {CommandComplete procedure} {
848    info complete "# Complete comment\\\\\n"
849} 1
850test parse-15.48 {CommandComplete procedure} {
851    info complete "abc\\\n def"
852} 1
853test parse-15.49 {CommandComplete procedure} {
854    info complete "abc\\\n "
855} 1
856test parse-15.50 {CommandComplete procedure} {
857    info complete "abc\\\n"
858} 0
859test parse-15.51 {CommandComplete procedure} "
860    info complete \"\\\{abc\\\}\\\{\"
861" 1
862test parse-15.52 {CommandComplete procedure} {
863    info complete "\"abc\"("
864} 1
865test parse-15.53 {CommandComplete procedure} "
866    info complete \" # \{\"
867" 1
868test parse-15.54 {CommandComplete procedure} "
869    info complete \"foo bar;# \{\"
870" 1
871test parse-15.55 {CommandComplete procedure} {
872    info complete "set x [bytestring \0]; puts hi"
873} 1
874test parse-15.56 {CommandComplete procedure} {
875    info complete "set x [bytestring \0]; \{"
876} 0
877test parse-15.57 {CommandComplete procedure} {
878    info complete "# Comment should be complete command"
879} 1
880test 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
883test parse-15.59 {CommandComplete procedure} {
884    # Test for Tcl Bug 684744
885    info complete [encoding convertfrom identity "\x00;if 1 \{"]
886} 0
887
888test 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
892test parse-17.1 {Correct return codes from errors during substitution} {
893    catch {eval {w[continue]}}
894} 4
895
896test parse-18.1 {Tcl_SubstObj, ParseTokens flags} {
897    subst {foo\t$::tcl_library\t[set ::tcl_library]}
898} "foo  $::tcl_library  $::tcl_library"
899test 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]"
902test parse-18.3 {Tcl_SubstObj, ParseTokens flags} {
903    subst -novariables {foo\t$::tcl_library\t[set ::tcl_library]}
904} "foo  \$::tcl_library $::tcl_library"
905test 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"
908test 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"
911test 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]"
914test 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]"
917test 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
922test parse-18.9 {Tcl_SubstObj, parse errors} {
923    list [catch "subst foo\$\{foo" msg] $msg
924} [list 1 "missing close-brace for variable name"]
925test 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"]
928test 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"]
931test parse-18.12 {Tcl_SubstObj, parse errors} {
932    list [catch "subst foo\$(\$\{foo)" msg] $msg
933} [list 1 "missing close-brace for variable name"]
934test parse-18.13 {Tcl_SubstObj, parse errors} {
935    list [catch "subst \[" msg] $msg
936} [list 1 "missing close-bracket"]
937
938test parse-18.14 {Tcl_SubstObj, exception handling} {
939    subst {abc,[break],def}
940} {abc,}
941test parse-18.15 {Tcl_SubstObj, exception handling} {
942    subst {abc,[continue; expr 1+2],def}
943} {abc,,def}
944test parse-18.16 {Tcl_SubstObj, exception handling} {
945    subst {abc,[return foo; expr 1+2],def}
946} {abc,foo,def}
947test parse-18.17 {Tcl_SubstObj, exception handling} {
948    subst {abc,[return -code 10 foo; expr 1+2],def}
949} {abc,foo,def}
950test parse-18.18 {Tcl_SubstObj, exception handling} {
951    subst {abc,[break; set {} {}{}],def}
952} {abc,}
953test 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"]
956test 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"]
959test 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
965test parse-18.22 {Tcl_SubstObj, side effects} {
966    set a 0
967    list [subst {foo[incr a]bar}] $a
968} [list foo1bar 1]
969test 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]
973test 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]
977test 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]
981test 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]
985test 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]
989test 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
994test 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
999test 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
1005test 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
1018test 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
1031test 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
1041test 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
1051cleanupTests
1052}
1053
1054namespace delete ::tcl::test::parse
1055return
Note: See TracBrowser for help on using the repository browser.