|
sl@0
|
1 |
# Commands covered: subst
|
|
sl@0
|
2 |
#
|
|
sl@0
|
3 |
# This file contains a collection of tests for one or more of the Tcl
|
|
sl@0
|
4 |
# built-in commands. Sourcing this file into Tcl runs the tests and
|
|
sl@0
|
5 |
# generates output for errors. No output means no errors were found.
|
|
sl@0
|
6 |
#
|
|
sl@0
|
7 |
# Copyright (c) 1994 The Regents of the University of California.
|
|
sl@0
|
8 |
# Copyright (c) 1994 Sun Microsystems, Inc.
|
|
sl@0
|
9 |
# Copyright (c) 1998-2000 Ajuba Solutions.
|
|
sl@0
|
10 |
#
|
|
sl@0
|
11 |
# See the file "license.terms" for information on usage and redistribution
|
|
sl@0
|
12 |
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
sl@0
|
13 |
#
|
|
sl@0
|
14 |
# RCS: @(#) $Id: subst.test,v 1.13.2.7 2004/10/26 21:42:53 dgp Exp $
|
|
sl@0
|
15 |
|
|
sl@0
|
16 |
if {[lsearch [namespace children] ::tcltest] == -1} {
|
|
sl@0
|
17 |
package require tcltest
|
|
sl@0
|
18 |
namespace import -force ::tcltest::*
|
|
sl@0
|
19 |
}
|
|
sl@0
|
20 |
|
|
sl@0
|
21 |
test subst-1.1 {basics} {
|
|
sl@0
|
22 |
list [catch {subst} msg] $msg
|
|
sl@0
|
23 |
} {1 {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}}
|
|
sl@0
|
24 |
test subst-1.2 {basics} {
|
|
sl@0
|
25 |
list [catch {subst a b c} msg] $msg
|
|
sl@0
|
26 |
} {1 {bad switch "a": must be -nobackslashes, -nocommands, or -novariables}}
|
|
sl@0
|
27 |
|
|
sl@0
|
28 |
test subst-2.1 {simple strings} {
|
|
sl@0
|
29 |
subst {}
|
|
sl@0
|
30 |
} {}
|
|
sl@0
|
31 |
test subst-2.2 {simple strings} {
|
|
sl@0
|
32 |
subst a
|
|
sl@0
|
33 |
} a
|
|
sl@0
|
34 |
test subst-2.3 {simple strings} {
|
|
sl@0
|
35 |
subst abcdefg
|
|
sl@0
|
36 |
} abcdefg
|
|
sl@0
|
37 |
test subst-2.4 {simple strings} {
|
|
sl@0
|
38 |
# Tcl Bug 685106
|
|
sl@0
|
39 |
subst [bytestring bar\x00soom]
|
|
sl@0
|
40 |
} [bytestring bar\x00soom]
|
|
sl@0
|
41 |
|
|
sl@0
|
42 |
test subst-3.1 {backslash substitutions} {
|
|
sl@0
|
43 |
subst {\x\$x\[foo bar]\\}
|
|
sl@0
|
44 |
} "x\$x\[foo bar]\\"
|
|
sl@0
|
45 |
test subst-3.2 {backslash substitutions with utf chars} {
|
|
sl@0
|
46 |
# 'j' is just a char that doesn't mean anything, and \344 is 'ä'
|
|
sl@0
|
47 |
# that also doesn't mean anything, but is multi-byte in UTF-8.
|
|
sl@0
|
48 |
list [subst \j] [subst \\j] [subst \\344] [subst \\\344]
|
|
sl@0
|
49 |
} "j j \344 \344"
|
|
sl@0
|
50 |
|
|
sl@0
|
51 |
test subst-4.1 {variable substitutions} {
|
|
sl@0
|
52 |
set a 44
|
|
sl@0
|
53 |
subst {$a}
|
|
sl@0
|
54 |
} {44}
|
|
sl@0
|
55 |
test subst-4.2 {variable substitutions} {
|
|
sl@0
|
56 |
set a 44
|
|
sl@0
|
57 |
subst {x$a.y{$a}.z}
|
|
sl@0
|
58 |
} {x44.y{44}.z}
|
|
sl@0
|
59 |
test subst-4.3 {variable substitutions} {
|
|
sl@0
|
60 |
catch {unset a}
|
|
sl@0
|
61 |
set a(13) 82
|
|
sl@0
|
62 |
set i 13
|
|
sl@0
|
63 |
subst {x.$a($i)}
|
|
sl@0
|
64 |
} {x.82}
|
|
sl@0
|
65 |
catch {unset a}
|
|
sl@0
|
66 |
set long {This is a very long string, intentionally made so long that it
|
|
sl@0
|
67 |
will overflow the static character size for dstrings, so that
|
|
sl@0
|
68 |
additional memory will have to be allocated by subst. That way,
|
|
sl@0
|
69 |
if the subst procedure forgets to free up memory while returning
|
|
sl@0
|
70 |
an error, there will be memory that isn't freed (this will be
|
|
sl@0
|
71 |
detected when the tests are run under a checking memory allocator
|
|
sl@0
|
72 |
such as Purify).}
|
|
sl@0
|
73 |
test subst-4.4 {variable substitutions} {
|
|
sl@0
|
74 |
list [catch {subst {$long $a}} msg] $msg
|
|
sl@0
|
75 |
} {1 {can't read "a": no such variable}}
|
|
sl@0
|
76 |
|
|
sl@0
|
77 |
test subst-5.1 {command substitutions} {
|
|
sl@0
|
78 |
subst {[concat {}]}
|
|
sl@0
|
79 |
} {}
|
|
sl@0
|
80 |
test subst-5.2 {command substitutions} {
|
|
sl@0
|
81 |
subst {[concat A test string]}
|
|
sl@0
|
82 |
} {A test string}
|
|
sl@0
|
83 |
test subst-5.3 {command substitutions} {
|
|
sl@0
|
84 |
subst {x.[concat foo].y.[concat bar].z}
|
|
sl@0
|
85 |
} {x.foo.y.bar.z}
|
|
sl@0
|
86 |
test subst-5.4 {command substitutions} {
|
|
sl@0
|
87 |
list [catch {subst {$long [set long] [bogus_command]}} msg] $msg
|
|
sl@0
|
88 |
} {1 {invalid command name "bogus_command"}}
|
|
sl@0
|
89 |
test subst-5.5 {command substitutions} {
|
|
sl@0
|
90 |
set a 0
|
|
sl@0
|
91 |
list [catch {subst {[set a 1}} msg] $a $msg
|
|
sl@0
|
92 |
} {1 0 {missing close-bracket}}
|
|
sl@0
|
93 |
test subst-5.6 {command substitutions} {
|
|
sl@0
|
94 |
set a 0
|
|
sl@0
|
95 |
list [catch {subst {0[set a 1}} msg] $a $msg
|
|
sl@0
|
96 |
} {1 0 {missing close-bracket}}
|
|
sl@0
|
97 |
test subst-5.7 {command substitutions} {
|
|
sl@0
|
98 |
set a 0
|
|
sl@0
|
99 |
list [catch {subst {0[set a 1; set a 2}} msg] $a $msg
|
|
sl@0
|
100 |
} {1 1 {missing close-bracket}}
|
|
sl@0
|
101 |
|
|
sl@0
|
102 |
# repeat the tests above simulating cmd line input
|
|
sl@0
|
103 |
test subst-5.8 {command substitutions} {
|
|
sl@0
|
104 |
set script {[subst {[set a 1}]}
|
|
sl@0
|
105 |
list [catch {exec [info nameofexecutable] << $script} msg] $msg
|
|
sl@0
|
106 |
} {1 {missing close-bracket}}
|
|
sl@0
|
107 |
test subst-5.9 {command substitutions} {
|
|
sl@0
|
108 |
set script {[subst {0[set a 1}]}
|
|
sl@0
|
109 |
list [catch {exec [info nameofexecutable] << $script} msg] $msg
|
|
sl@0
|
110 |
} {1 {missing close-bracket}}
|
|
sl@0
|
111 |
test subst-5.10 {command substitutions} {
|
|
sl@0
|
112 |
set script {[subst {0[set a 1; set a 2}]}
|
|
sl@0
|
113 |
list [catch {exec [info nameofexecutable] << $script} msg] $msg
|
|
sl@0
|
114 |
} {1 {missing close-bracket}}
|
|
sl@0
|
115 |
|
|
sl@0
|
116 |
test subst-6.1 {clear the result after command substitution} {
|
|
sl@0
|
117 |
catch {unset a}
|
|
sl@0
|
118 |
list [catch {subst {[concat foo] $a}} msg] $msg
|
|
sl@0
|
119 |
} {1 {can't read "a": no such variable}}
|
|
sl@0
|
120 |
|
|
sl@0
|
121 |
test subst-7.1 {switches} {
|
|
sl@0
|
122 |
list [catch {subst foo bar} msg] $msg
|
|
sl@0
|
123 |
} {1 {bad switch "foo": must be -nobackslashes, -nocommands, or -novariables}}
|
|
sl@0
|
124 |
test subst-7.2 {switches} {
|
|
sl@0
|
125 |
list [catch {subst -no bar} msg] $msg
|
|
sl@0
|
126 |
} {1 {ambiguous switch "-no": must be -nobackslashes, -nocommands, or -novariables}}
|
|
sl@0
|
127 |
test subst-7.3 {switches} {
|
|
sl@0
|
128 |
list [catch {subst -bogus bar} msg] $msg
|
|
sl@0
|
129 |
} {1 {bad switch "-bogus": must be -nobackslashes, -nocommands, or -novariables}}
|
|
sl@0
|
130 |
test subst-7.4 {switches} {
|
|
sl@0
|
131 |
set x 123
|
|
sl@0
|
132 |
subst -nobackslashes {abc $x [expr 1+2] \\\x41}
|
|
sl@0
|
133 |
} {abc 123 3 \\\x41}
|
|
sl@0
|
134 |
test subst-7.5 {switches} {
|
|
sl@0
|
135 |
set x 123
|
|
sl@0
|
136 |
subst -nocommands {abc $x [expr 1+2] \\\x41}
|
|
sl@0
|
137 |
} {abc 123 [expr 1+2] \A}
|
|
sl@0
|
138 |
test subst-7.6 {switches} {
|
|
sl@0
|
139 |
set x 123
|
|
sl@0
|
140 |
subst -novariables {abc $x [expr 1+2] \\\x41}
|
|
sl@0
|
141 |
} {abc $x 3 \A}
|
|
sl@0
|
142 |
test subst-7.7 {switches} {
|
|
sl@0
|
143 |
set x 123
|
|
sl@0
|
144 |
subst -nov -nob -noc {abc $x [expr 1+2] \\\x41}
|
|
sl@0
|
145 |
} {abc $x [expr 1+2] \\\x41}
|
|
sl@0
|
146 |
|
|
sl@0
|
147 |
test subst-8.1 {return in a subst} {
|
|
sl@0
|
148 |
subst {foo [return {x}; bogus code] bar}
|
|
sl@0
|
149 |
} {foo x bar}
|
|
sl@0
|
150 |
test subst-8.2 {return in a subst} {
|
|
sl@0
|
151 |
subst {foo [return x ; bogus code] bar}
|
|
sl@0
|
152 |
} {foo x bar}
|
|
sl@0
|
153 |
test subst-8.3 {return in a subst} {
|
|
sl@0
|
154 |
subst {foo [if 1 { return {x}; bogus code }] bar}
|
|
sl@0
|
155 |
} {foo x bar}
|
|
sl@0
|
156 |
test subst-8.4 {return in a subst} {
|
|
sl@0
|
157 |
subst {[eval {return hi}] there}
|
|
sl@0
|
158 |
} {hi there}
|
|
sl@0
|
159 |
test subst-8.5 {return in a subst} {
|
|
sl@0
|
160 |
subst {foo [return {]}; bogus code] bar}
|
|
sl@0
|
161 |
} {foo ] bar}
|
|
sl@0
|
162 |
test subst-8.6 {return in a subst} {
|
|
sl@0
|
163 |
list [catch {subst {foo [return {x}; bogus code bar}} msg] $msg
|
|
sl@0
|
164 |
} {1 {missing close-bracket}}
|
|
sl@0
|
165 |
test subst-8.7 {return in a subst, parse error} {
|
|
sl@0
|
166 |
subst {foo [return {x} ; set a {}" ; stuff] bar}
|
|
sl@0
|
167 |
} {foo xset a {}" ; stuff] bar}
|
|
sl@0
|
168 |
test subst-8.8 {return in a subst, parse error} {
|
|
sl@0
|
169 |
subst {foo [return {x} ; set bar baz ; set a {}" ; stuff] bar}
|
|
sl@0
|
170 |
} {foo xset bar baz ; set a {}" ; stuff] bar}
|
|
sl@0
|
171 |
test subst-8.9 {return in a variable subst} {
|
|
sl@0
|
172 |
subst {foo $var([return {x}]) bar}
|
|
sl@0
|
173 |
} {foo x bar}
|
|
sl@0
|
174 |
|
|
sl@0
|
175 |
test subst-9.1 {error in a subst} {
|
|
sl@0
|
176 |
list [catch {subst {[error foo; bogus code]bar}} msg] $msg
|
|
sl@0
|
177 |
} {1 foo}
|
|
sl@0
|
178 |
test subst-9.2 {error in a subst} {
|
|
sl@0
|
179 |
list [catch {subst {[if 1 { error foo; bogus code}]bar}} msg] $msg
|
|
sl@0
|
180 |
} {1 foo}
|
|
sl@0
|
181 |
test subst-9.3 {error in a variable subst} {
|
|
sl@0
|
182 |
list [catch {subst {foo $var([error foo]) bar}} msg] $msg
|
|
sl@0
|
183 |
} {1 foo}
|
|
sl@0
|
184 |
|
|
sl@0
|
185 |
test subst-10.1 {break in a subst} {
|
|
sl@0
|
186 |
subst {foo [break; bogus code] bar}
|
|
sl@0
|
187 |
} {foo }
|
|
sl@0
|
188 |
test subst-10.2 {break in a subst} {
|
|
sl@0
|
189 |
subst {foo [break; return x; bogus code] bar}
|
|
sl@0
|
190 |
} {foo }
|
|
sl@0
|
191 |
test subst-10.3 {break in a subst} {
|
|
sl@0
|
192 |
subst {foo [if 1 { break; bogus code}] bar}
|
|
sl@0
|
193 |
} {foo }
|
|
sl@0
|
194 |
test subst-10.4 {break in a subst, parse error} {
|
|
sl@0
|
195 |
subst {foo [break ; set a {}{} ; stuff] bar}
|
|
sl@0
|
196 |
} {foo }
|
|
sl@0
|
197 |
test subst-10.5 {break in a subst, parse error} {
|
|
sl@0
|
198 |
subst {foo [break ;set bar baz ;set a {}{} ; stuff] bar}
|
|
sl@0
|
199 |
} {foo }
|
|
sl@0
|
200 |
test subst-10.6 {break in a variable subst} {
|
|
sl@0
|
201 |
subst {foo $var([break]) bar}
|
|
sl@0
|
202 |
} {foo }
|
|
sl@0
|
203 |
|
|
sl@0
|
204 |
test subst-11.1 {continue in a subst} {
|
|
sl@0
|
205 |
subst {foo [continue; bogus code] bar}
|
|
sl@0
|
206 |
} {foo bar}
|
|
sl@0
|
207 |
test subst-11.2 {continue in a subst} {
|
|
sl@0
|
208 |
subst {foo [continue; return x; bogus code] bar}
|
|
sl@0
|
209 |
} {foo bar}
|
|
sl@0
|
210 |
test subst-11.3 {continue in a subst} {
|
|
sl@0
|
211 |
subst {foo [if 1 { continue; bogus code}] bar}
|
|
sl@0
|
212 |
} {foo bar}
|
|
sl@0
|
213 |
test subst-11.4 {continue in a subst, parse error} {
|
|
sl@0
|
214 |
subst {foo [continue ; set a {}{} ; stuff] bar}
|
|
sl@0
|
215 |
} {foo set a {}{} ; stuff] bar}
|
|
sl@0
|
216 |
test subst-11.5 {continue in a subst, parse error} {
|
|
sl@0
|
217 |
subst {foo [continue ;set bar baz ;set a {}{} ; stuff] bar}
|
|
sl@0
|
218 |
} {foo set bar baz ;set a {}{} ; stuff] bar}
|
|
sl@0
|
219 |
test subst-11.6 {continue in a variable subst} {
|
|
sl@0
|
220 |
subst {foo $var([continue]) bar}
|
|
sl@0
|
221 |
} {foo bar}
|
|
sl@0
|
222 |
|
|
sl@0
|
223 |
test subst-12.1 {nasty case, Bug 1036649} {
|
|
sl@0
|
224 |
for {set i 0} {$i < 10} {incr i} {
|
|
sl@0
|
225 |
set res [list [catch {subst "\[subst {};"} msg] $msg]
|
|
sl@0
|
226 |
if {$msg ne "missing close-bracket"} break
|
|
sl@0
|
227 |
}
|
|
sl@0
|
228 |
set res
|
|
sl@0
|
229 |
} {1 {missing close-bracket}}
|
|
sl@0
|
230 |
test subst-12.2 {nasty case, Bug 1036649} {
|
|
sl@0
|
231 |
for {set i 0} {$i < 10} {incr i} {
|
|
sl@0
|
232 |
set res [list [catch {subst "\[subst {}; "} msg] $msg]
|
|
sl@0
|
233 |
if {$msg ne "missing close-bracket"} break
|
|
sl@0
|
234 |
}
|
|
sl@0
|
235 |
set res
|
|
sl@0
|
236 |
} {1 {missing close-bracket}}
|
|
sl@0
|
237 |
test subst-12.3 {nasty case, Bug 1036649} {
|
|
sl@0
|
238 |
set x 0
|
|
sl@0
|
239 |
for {set i 0} {$i < 10} {incr i} {
|
|
sl@0
|
240 |
set res [list [catch {subst "\[incr x;"} msg] $msg]
|
|
sl@0
|
241 |
if {$msg ne "missing close-bracket"} break
|
|
sl@0
|
242 |
}
|
|
sl@0
|
243 |
list $res $x
|
|
sl@0
|
244 |
} {{1 {missing close-bracket}} 10}
|
|
sl@0
|
245 |
test subst-12.4 {nasty case, Bug 1036649} {
|
|
sl@0
|
246 |
set x 0
|
|
sl@0
|
247 |
for {set i 0} {$i < 10} {incr i} {
|
|
sl@0
|
248 |
set res [list [catch {subst "\[incr x; "} msg] $msg]
|
|
sl@0
|
249 |
if {$msg ne "missing close-bracket"} break
|
|
sl@0
|
250 |
}
|
|
sl@0
|
251 |
list $res $x
|
|
sl@0
|
252 |
} {{1 {missing close-bracket}} 10}
|
|
sl@0
|
253 |
test subst-12.5 {nasty case, Bug 1036649} {
|
|
sl@0
|
254 |
set x 0
|
|
sl@0
|
255 |
for {set i 0} {$i < 10} {incr i} {
|
|
sl@0
|
256 |
set res [list [catch {subst "\[incr x"} msg] $msg]
|
|
sl@0
|
257 |
if {$msg ne "missing close-bracket"} break
|
|
sl@0
|
258 |
}
|
|
sl@0
|
259 |
list $res $x
|
|
sl@0
|
260 |
} {{1 {missing close-bracket}} 0}
|
|
sl@0
|
261 |
|
|
sl@0
|
262 |
# cleanup
|
|
sl@0
|
263 |
::tcltest::cleanupTests
|
|
sl@0
|
264 |
return
|