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