|
sl@0
|
1 |
# Commands covered: source
|
|
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) 1991-1993 The Regents of the University of California.
|
|
sl@0
|
8 |
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
|
|
sl@0
|
9 |
# Copyright (c) 1998-2000 by Scriptics Corporation.
|
|
sl@0
|
10 |
# Contributions from Don Porter, NIST, 2003. (not subject to US copyright)
|
|
sl@0
|
11 |
#
|
|
sl@0
|
12 |
# See the file "license.terms" for information on usage and redistribution
|
|
sl@0
|
13 |
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
sl@0
|
14 |
#
|
|
sl@0
|
15 |
# RCS: @(#) $Id: source.test,v 1.8.2.2 2004/02/25 23:38:17 dgp Exp $
|
|
sl@0
|
16 |
|
|
sl@0
|
17 |
if {[catch {package require tcltest 2.1}]} {
|
|
sl@0
|
18 |
puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
|
|
sl@0
|
19 |
return
|
|
sl@0
|
20 |
}
|
|
sl@0
|
21 |
|
|
sl@0
|
22 |
namespace eval ::tcl::test::source {
|
|
sl@0
|
23 |
namespace import ::tcltest::test
|
|
sl@0
|
24 |
namespace import ::tcltest::testConstraint
|
|
sl@0
|
25 |
namespace import ::tcltest::cleanupTests
|
|
sl@0
|
26 |
namespace import ::tcltest::makeFile
|
|
sl@0
|
27 |
namespace import ::tcltest::removeFile
|
|
sl@0
|
28 |
namespace import ::tcltest::customMatch
|
|
sl@0
|
29 |
|
|
sl@0
|
30 |
test source-1.1 {source command} -setup {
|
|
sl@0
|
31 |
set x "old x value"
|
|
sl@0
|
32 |
set y "old y value"
|
|
sl@0
|
33 |
set z "old z value"
|
|
sl@0
|
34 |
set sourcefile [makeFile {
|
|
sl@0
|
35 |
set x 22
|
|
sl@0
|
36 |
set y 33
|
|
sl@0
|
37 |
set z 44
|
|
sl@0
|
38 |
} source.file]
|
|
sl@0
|
39 |
} -body {
|
|
sl@0
|
40 |
source $sourcefile
|
|
sl@0
|
41 |
list $x $y $z
|
|
sl@0
|
42 |
} -cleanup {
|
|
sl@0
|
43 |
removeFile source.file
|
|
sl@0
|
44 |
} -result {22 33 44}
|
|
sl@0
|
45 |
|
|
sl@0
|
46 |
test source-1.2 {source command} -setup {
|
|
sl@0
|
47 |
set sourcefile [makeFile {list result} source.file]
|
|
sl@0
|
48 |
} -body {
|
|
sl@0
|
49 |
source $sourcefile
|
|
sl@0
|
50 |
} -cleanup {
|
|
sl@0
|
51 |
removeFile source.file
|
|
sl@0
|
52 |
} -result result
|
|
sl@0
|
53 |
|
|
sl@0
|
54 |
test source-1.3 {source command} -setup {
|
|
sl@0
|
55 |
set sourcefile [makeFile {} source.file]
|
|
sl@0
|
56 |
set fd [open $sourcefile w]
|
|
sl@0
|
57 |
fconfigure $fd -translation lf
|
|
sl@0
|
58 |
puts $fd "list a b c \\"
|
|
sl@0
|
59 |
puts $fd "d e f"
|
|
sl@0
|
60 |
close $fd
|
|
sl@0
|
61 |
} -body {
|
|
sl@0
|
62 |
source $sourcefile
|
|
sl@0
|
63 |
} -cleanup {
|
|
sl@0
|
64 |
removeFile source.file
|
|
sl@0
|
65 |
} -result {a b c d e f}
|
|
sl@0
|
66 |
|
|
sl@0
|
67 |
proc ListGlobMatch {expected actual} {
|
|
sl@0
|
68 |
if {[llength $expected] != [llength $actual]} {
|
|
sl@0
|
69 |
return 0
|
|
sl@0
|
70 |
}
|
|
sl@0
|
71 |
foreach e $expected a $actual {
|
|
sl@0
|
72 |
if {![string match $e $a]} {
|
|
sl@0
|
73 |
return 0
|
|
sl@0
|
74 |
}
|
|
sl@0
|
75 |
}
|
|
sl@0
|
76 |
return 1
|
|
sl@0
|
77 |
}
|
|
sl@0
|
78 |
customMatch listGlob [namespace which ListGlobMatch]
|
|
sl@0
|
79 |
|
|
sl@0
|
80 |
test source-2.3 {source error conditions} -setup {
|
|
sl@0
|
81 |
set sourcefile [makeFile {
|
|
sl@0
|
82 |
set x 146
|
|
sl@0
|
83 |
error "error in sourced file"
|
|
sl@0
|
84 |
set y $x
|
|
sl@0
|
85 |
} source.file]
|
|
sl@0
|
86 |
} -body {
|
|
sl@0
|
87 |
list [catch {source $sourcefile} msg] $msg $::errorInfo
|
|
sl@0
|
88 |
} -cleanup {
|
|
sl@0
|
89 |
removeFile source.file
|
|
sl@0
|
90 |
} -match listGlob -result [list 1 {error in sourced file} \
|
|
sl@0
|
91 |
{error in sourced file
|
|
sl@0
|
92 |
while executing
|
|
sl@0
|
93 |
"error "error in sourced file""
|
|
sl@0
|
94 |
(file "*source.file" line 3)
|
|
sl@0
|
95 |
invoked from within
|
|
sl@0
|
96 |
"source $sourcefile"}]
|
|
sl@0
|
97 |
|
|
sl@0
|
98 |
test source-2.4 {source error conditions} -setup {
|
|
sl@0
|
99 |
set sourcefile [makeFile {break} source.file]
|
|
sl@0
|
100 |
} -body {
|
|
sl@0
|
101 |
source $sourcefile
|
|
sl@0
|
102 |
} -cleanup {
|
|
sl@0
|
103 |
removeFile source.file
|
|
sl@0
|
104 |
} -returnCodes break
|
|
sl@0
|
105 |
|
|
sl@0
|
106 |
test source-2.5 {source error conditions} -setup {
|
|
sl@0
|
107 |
set sourcefile [makeFile {continue} source.file]
|
|
sl@0
|
108 |
} -body {
|
|
sl@0
|
109 |
source $sourcefile
|
|
sl@0
|
110 |
} -cleanup {
|
|
sl@0
|
111 |
removeFile source.file
|
|
sl@0
|
112 |
} -returnCodes continue
|
|
sl@0
|
113 |
|
|
sl@0
|
114 |
test source-2.6 {source error conditions} -setup {
|
|
sl@0
|
115 |
set sourcefile [makeFile {} _non_existent_]
|
|
sl@0
|
116 |
removeFile _non_existent_
|
|
sl@0
|
117 |
} -body {
|
|
sl@0
|
118 |
list [catch {source $sourcefile} msg] $msg $::errorCode
|
|
sl@0
|
119 |
} -match listGlob -result [list 1 \
|
|
sl@0
|
120 |
{couldn't read file "*_non_existent_": no such file or directory} \
|
|
sl@0
|
121 |
{POSIX ENOENT {no such file or directory}}]
|
|
sl@0
|
122 |
|
|
sl@0
|
123 |
|
|
sl@0
|
124 |
test source-3.1 {return in middle of source file} -setup {
|
|
sl@0
|
125 |
set sourcefile [makeFile {
|
|
sl@0
|
126 |
set x new-x
|
|
sl@0
|
127 |
return allDone
|
|
sl@0
|
128 |
set y new-y
|
|
sl@0
|
129 |
} source.file]
|
|
sl@0
|
130 |
} -body {
|
|
sl@0
|
131 |
set x old-x
|
|
sl@0
|
132 |
set y old-y
|
|
sl@0
|
133 |
set z [source $sourcefile]
|
|
sl@0
|
134 |
list $x $y $z
|
|
sl@0
|
135 |
} -cleanup {
|
|
sl@0
|
136 |
removeFile source.file
|
|
sl@0
|
137 |
} -result {new-x old-y allDone}
|
|
sl@0
|
138 |
|
|
sl@0
|
139 |
test source-3.2 {return with special code etc.} -setup {
|
|
sl@0
|
140 |
set sourcefile [makeFile {
|
|
sl@0
|
141 |
set x new-x
|
|
sl@0
|
142 |
return -code break "Silly result"
|
|
sl@0
|
143 |
set y new-y
|
|
sl@0
|
144 |
} source.file]
|
|
sl@0
|
145 |
} -body {
|
|
sl@0
|
146 |
source $sourcefile
|
|
sl@0
|
147 |
} -cleanup {
|
|
sl@0
|
148 |
removeFile source.file
|
|
sl@0
|
149 |
} -returnCodes break -result {Silly result}
|
|
sl@0
|
150 |
|
|
sl@0
|
151 |
test source-3.3 {return with special code etc.} -setup {
|
|
sl@0
|
152 |
set sourcefile [makeFile {
|
|
sl@0
|
153 |
set x new-x
|
|
sl@0
|
154 |
return -code error "Simulated error"
|
|
sl@0
|
155 |
set y new-y
|
|
sl@0
|
156 |
} source.file]
|
|
sl@0
|
157 |
} -body {
|
|
sl@0
|
158 |
list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode
|
|
sl@0
|
159 |
} -cleanup {
|
|
sl@0
|
160 |
removeFile source.file
|
|
sl@0
|
161 |
} -result {1 {Simulated error} {Simulated error
|
|
sl@0
|
162 |
while executing
|
|
sl@0
|
163 |
"source $sourcefile"} NONE}
|
|
sl@0
|
164 |
|
|
sl@0
|
165 |
test source-3.4 {return with special code etc.} -setup {
|
|
sl@0
|
166 |
set sourcefile [makeFile {
|
|
sl@0
|
167 |
set x new-x
|
|
sl@0
|
168 |
return -code error -errorinfo "Simulated errorInfo stuff"
|
|
sl@0
|
169 |
set y new-y
|
|
sl@0
|
170 |
} source.file]
|
|
sl@0
|
171 |
} -body {
|
|
sl@0
|
172 |
list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode
|
|
sl@0
|
173 |
} -cleanup {
|
|
sl@0
|
174 |
removeFile source.file
|
|
sl@0
|
175 |
} -result {1 {} {Simulated errorInfo stuff
|
|
sl@0
|
176 |
invoked from within
|
|
sl@0
|
177 |
"source $sourcefile"} NONE}
|
|
sl@0
|
178 |
|
|
sl@0
|
179 |
test source-3.5 {return with special code etc.} -setup {
|
|
sl@0
|
180 |
set sourcefile [makeFile {
|
|
sl@0
|
181 |
set x new-x
|
|
sl@0
|
182 |
return -code error -errorinfo "Simulated errorInfo stuff" \
|
|
sl@0
|
183 |
-errorcode {a b c}
|
|
sl@0
|
184 |
set y new-y
|
|
sl@0
|
185 |
} source.file]
|
|
sl@0
|
186 |
} -body {
|
|
sl@0
|
187 |
list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode
|
|
sl@0
|
188 |
} -cleanup {
|
|
sl@0
|
189 |
removeFile source.file
|
|
sl@0
|
190 |
} -result {1 {} {Simulated errorInfo stuff
|
|
sl@0
|
191 |
invoked from within
|
|
sl@0
|
192 |
"source $sourcefile"} {a b c}}
|
|
sl@0
|
193 |
|
|
sl@0
|
194 |
|
|
sl@0
|
195 |
# Test for the Macintosh specfic features of the source command
|
|
sl@0
|
196 |
test source-4.1 {source error conditions} -constraints macOnly -body {
|
|
sl@0
|
197 |
source -rsrc _no_exist_
|
|
sl@0
|
198 |
} -result {The resource "_no_exist_" could not be loaded from application.} \
|
|
sl@0
|
199 |
-returnCodes error
|
|
sl@0
|
200 |
|
|
sl@0
|
201 |
test source-4.2 {source error conditions} -constraints macOnly -body {
|
|
sl@0
|
202 |
source -rsrcid bad_id
|
|
sl@0
|
203 |
} -returnCodes error -result {expected integer but got "bad_id"}
|
|
sl@0
|
204 |
|
|
sl@0
|
205 |
test source-4.3 {source error conditions} -constraints macOnly -body {
|
|
sl@0
|
206 |
source -rsrc rsrcName fileName extra
|
|
sl@0
|
207 |
} -returnCodes error -result {wrong # args: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?" or "source -encoding name fileName"}
|
|
sl@0
|
208 |
|
|
sl@0
|
209 |
test source-4.4 {source error conditions} -constraints macOnly -body {
|
|
sl@0
|
210 |
source non_switch rsrcName
|
|
sl@0
|
211 |
} -returnCodes error -result {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?" or "source -encoding name fileName"}
|
|
sl@0
|
212 |
|
|
sl@0
|
213 |
test source-4.5 {source error conditions} -constraints macOnly -body {
|
|
sl@0
|
214 |
source -bad_switch argument
|
|
sl@0
|
215 |
} -returnCodes error -result {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?" or "source -encoding name fileName"}
|
|
sl@0
|
216 |
|
|
sl@0
|
217 |
|
|
sl@0
|
218 |
testConstraint testWriteTextResource \
|
|
sl@0
|
219 |
[llength [info commands testWriteTextResource]]
|
|
sl@0
|
220 |
|
|
sl@0
|
221 |
test source-5.1 {source resource files} -constraints macOnly -setup {
|
|
sl@0
|
222 |
set sourcefile [makeFile {} bad_file]
|
|
sl@0
|
223 |
removeFile bad_file
|
|
sl@0
|
224 |
} -body {
|
|
sl@0
|
225 |
source -rsrc rsrcName $sourcefile
|
|
sl@0
|
226 |
} -returnCodes error -match glob -result {Error finding the file: "*bad_file".}
|
|
sl@0
|
227 |
|
|
sl@0
|
228 |
test source-5.2 {source resource files} -constraints macOnly -setup {
|
|
sl@0
|
229 |
set sourcefile [makeFile {return} source.file]
|
|
sl@0
|
230 |
} -body {
|
|
sl@0
|
231 |
source -rsrc rsrcName $sourcefile
|
|
sl@0
|
232 |
} -cleanup {
|
|
sl@0
|
233 |
removeFile source.file
|
|
sl@0
|
234 |
} -returnCodes error -match glob \
|
|
sl@0
|
235 |
-result {Error reading the file: "*source.file".}
|
|
sl@0
|
236 |
|
|
sl@0
|
237 |
test source-5.3 {source resource files} -constraints {
|
|
sl@0
|
238 |
macOnly testWriteTextResource
|
|
sl@0
|
239 |
} -setup {
|
|
sl@0
|
240 |
set msg2 unset
|
|
sl@0
|
241 |
set rsrcFile [makeFile {} rsrc.file]
|
|
sl@0
|
242 |
removeFile rsrc.file
|
|
sl@0
|
243 |
testWriteTextResource -rsrc rsrcName -file $rsrc.file {set msg2 ok; return}
|
|
sl@0
|
244 |
} -body {
|
|
sl@0
|
245 |
set result [catch {source -rsrc rsrcName rsrc.file} msg]
|
|
sl@0
|
246 |
list $msg2 $result $msg
|
|
sl@0
|
247 |
} -cleanup {
|
|
sl@0
|
248 |
removeFile rsrc.file
|
|
sl@0
|
249 |
} -result [list ok 0 {}]
|
|
sl@0
|
250 |
|
|
sl@0
|
251 |
test source-5.4 {source resource files} -constraints {
|
|
sl@0
|
252 |
macOnly testWriteTextResource
|
|
sl@0
|
253 |
} -setup {
|
|
sl@0
|
254 |
set msg2 unset
|
|
sl@0
|
255 |
set rsrsFile [makeFile {} rsrc.file]
|
|
sl@0
|
256 |
removeFile rsrc.file
|
|
sl@0
|
257 |
testWriteTextResource -rsrc fileRsrcName \
|
|
sl@0
|
258 |
-file $rsrcFile {set msg2 ok; return}
|
|
sl@0
|
259 |
} -body {
|
|
sl@0
|
260 |
source -rsrc fileRsrcName $rsrcFile
|
|
sl@0
|
261 |
set result [catch {source -rsrc fileRsrcName} msg]
|
|
sl@0
|
262 |
list $msg2 $result $msg
|
|
sl@0
|
263 |
} -cleanup {
|
|
sl@0
|
264 |
removeFile rsrc.file
|
|
sl@0
|
265 |
} -result [list ok 1 {The resource "fileRsrcName" could not be loaded from application.}]
|
|
sl@0
|
266 |
|
|
sl@0
|
267 |
test source-5.5 {source resource files} -constraints {
|
|
sl@0
|
268 |
macOnly testWriteTextResource
|
|
sl@0
|
269 |
} -setup {
|
|
sl@0
|
270 |
set msg2 unset
|
|
sl@0
|
271 |
set rsrcFile [makeFile {} rsrc.file]
|
|
sl@0
|
272 |
removeFile rsrc.file
|
|
sl@0
|
273 |
testWriteTextResource -rsrcid 200 \
|
|
sl@0
|
274 |
-file $rsrcFile {set msg2 hello; set msg3 bye}
|
|
sl@0
|
275 |
} -body {
|
|
sl@0
|
276 |
set result [catch {source -rsrcid 200 $rsrcFile} msg]
|
|
sl@0
|
277 |
list $msg2 $result $msg
|
|
sl@0
|
278 |
} -cleanup {
|
|
sl@0
|
279 |
removeFile rsrc.file
|
|
sl@0
|
280 |
} -result [list hello 0 bye]
|
|
sl@0
|
281 |
|
|
sl@0
|
282 |
test source-5.6 {source resource files} -constraints {
|
|
sl@0
|
283 |
macOnly testWriteTextResource
|
|
sl@0
|
284 |
} -setup {
|
|
sl@0
|
285 |
set msg2 unset
|
|
sl@0
|
286 |
set rsrcFile [makeFile {} rsrc.file]
|
|
sl@0
|
287 |
removeFile rsrc.file
|
|
sl@0
|
288 |
testWriteTextResource -rsrcid 200 \
|
|
sl@0
|
289 |
-file $rsrcFile {set msg2 hello; error bad; set msg3 bye}
|
|
sl@0
|
290 |
} -body {
|
|
sl@0
|
291 |
set result [catch {source -rsrcid 200 rsrc.file} msg]
|
|
sl@0
|
292 |
list $msg2 $result $msg
|
|
sl@0
|
293 |
} -cleanup {
|
|
sl@0
|
294 |
removeFile rsrc.file
|
|
sl@0
|
295 |
} -result [list hello 1 bad]
|
|
sl@0
|
296 |
|
|
sl@0
|
297 |
|
|
sl@0
|
298 |
test source-6.1 {source is binary ok} -setup {
|
|
sl@0
|
299 |
# Note [makeFile] writes in the system encoding.
|
|
sl@0
|
300 |
# [source] defaults to reading in the system encoding.
|
|
sl@0
|
301 |
set sourcefile [makeFile [list set x "a b\0c"] source.file]
|
|
sl@0
|
302 |
} -body {
|
|
sl@0
|
303 |
set x {}
|
|
sl@0
|
304 |
source $sourcefile
|
|
sl@0
|
305 |
string length $x
|
|
sl@0
|
306 |
} -cleanup {
|
|
sl@0
|
307 |
removeFile source.file
|
|
sl@0
|
308 |
} -result 5
|
|
sl@0
|
309 |
|
|
sl@0
|
310 |
test source-6.2 {source skips everything after Ctrl-Z: Bug 2040} -setup {
|
|
sl@0
|
311 |
set sourcefile [makeFile "set x ab\32c" source.file]
|
|
sl@0
|
312 |
} -body {
|
|
sl@0
|
313 |
set x {}
|
|
sl@0
|
314 |
source $sourcefile
|
|
sl@0
|
315 |
string length $x
|
|
sl@0
|
316 |
} -cleanup {
|
|
sl@0
|
317 |
removeFile source.file
|
|
sl@0
|
318 |
} -result 2
|
|
sl@0
|
319 |
|
|
sl@0
|
320 |
cleanupTests
|
|
sl@0
|
321 |
}
|
|
sl@0
|
322 |
namespace delete ::tcl::test::source
|
|
sl@0
|
323 |
return
|