summaryrefslogtreecommitdiffstats
path: root/tests/source.test
blob: 413c658c0a58e0364bc70773bcac11412e06e3e7 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
# Commands covered:  source
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Scriptics Corporation.
# Contributions from Don Porter, NIST, 2003.  (not subject to US copyright)
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: source.test,v 1.9 2003/09/05 21:52:12 dgp Exp $

if {[catch {package require tcltest 2.0.2}]} {
    puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
    return
}

namespace eval ::tcl::test::source {
    namespace import ::tcltest::test
    namespace import ::tcltest::testConstraint
    namespace import ::tcltest::cleanupTests
    namespace import ::tcltest::makeFile
    namespace import ::tcltest::removeFile

test source-1.1 {source command} -setup {
    set x "old x value"
    set y "old y value"
    set z "old z value"
    set sourcefile [makeFile {
	set x 22
	set y 33
	set z 44
    } source.file]
} -body {
    source $sourcefile
    list $x $y $z
} -cleanup {
    removeFile source.file
} -result {22 33 44}

test source-1.2 {source command} -setup {
    set sourcefile [makeFile {list result} source.file]
} -body {
    source $sourcefile
} -cleanup {
    removeFile source.file
} -result result

test source-1.3 {source command} -setup {
    set sourcefile [makeFile {} source.file]
    set fd [open $sourcefile w]
    fconfigure $fd -translation lf
    puts $fd "list a b c \\"
    puts $fd "d e f"
    close $fd
} -body {
    source $sourcefile
} -cleanup {
    removeFile source.file
} -result {a b c d e f}


test source-2.3 {source error conditions} -setup {
    set sourcefile [makeFile {
	set x 146
	error "error in sourced file"
	set y $x
    } source.file]
} -body {
    list [catch {source $sourcefile} msg] $msg $::errorInfo
} -cleanup {
    removeFile source.file
} -match glob -result [list 1 {error in sourced file} \
	{error in sourced file
    while executing
"error "error in sourced file""
    (file "*source.file" line 3)
    invoked from within
"source $sourcefile"}]

test source-2.4 {source error conditions} -setup {
    set sourcefile [makeFile {break} source.file]
} -body {
    source $sourcefile
} -cleanup {
    removeFile source.file
} -returnCodes break

test source-2.5 {source error conditions} -setup {
    set sourcefile [makeFile {continue} source.file]
} -body {
    source $sourcefile
} -cleanup {
    removeFile source.file
} -returnCodes continue

test source-2.6 {source error conditions} -setup {
    set sourcefile [makeFile {} _non_existent_]
    removeFile _non_existent_
} -body {
    list [catch {source $sourcefile} msg] $msg $::errorCode
} -match glob -result [list 1 \
	{couldn't read file "*_non_existent_": no such file or directory} \
	{POSIX ENOENT {no such file or directory}}]


test source-3.1 {return in middle of source file} -setup {
    set sourcefile [makeFile {
	set x new-x
	return allDone
	set y new-y
    } source.file]
} -body {
    set x old-x
    set y old-y
    set z [source $sourcefile]
    list $x $y $z
} -cleanup {
    removeFile source.file
} -result {new-x old-y allDone}

test source-3.2 {return with special code etc.} -setup {
    set sourcefile [makeFile {
	set x new-x
	return -code break "Silly result"
	set y new-y
    } source.file]
} -body {
   source $sourcefile
} -cleanup {
    removeFile source.file
} -returnCodes break -result {Silly result}

test source-3.3 {return with special code etc.} -setup {
    set sourcefile [makeFile {
	set x new-x
	return -code error "Simulated error"
	set y new-y
    } source.file]
} -body {
    list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode
} -cleanup {
    removeFile source.file
} -result {1 {Simulated error} {Simulated error
    while executing
"source $sourcefile"} NONE}

test source-3.4 {return with special code etc.} -setup {
    set sourcefile [makeFile {
	set x new-x
	return -code error -errorinfo "Simulated errorInfo stuff"
	set y new-y
    } source.file]
} -body {
    list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode
} -cleanup {
    removeFile source.file
} -result {1 {} {Simulated errorInfo stuff
    invoked from within
"source $sourcefile"} NONE}

test source-3.5 {return with special code etc.} -setup {
    set sourcefile [makeFile {
	set x new-x
	return -code error -errorinfo "Simulated errorInfo stuff" \
		-errorcode {a b c}
	set y new-y
    } source.file]
} -body {
    list [catch {source $sourcefile} msg] $msg $::errorInfo $::errorCode
} -cleanup {
    removeFile source.file
} -result {1 {} {Simulated errorInfo stuff
    invoked from within
"source $sourcefile"} {a b c}}


# Test for the Macintosh specfic features of the source command
test source-4.1 {source error conditions} -constraints macOnly -body {
    source -rsrc _no_exist_
} -result {The resource "_no_exist_" could not be loaded from application.} \
  -returnCodes error 

test source-4.2 {source error conditions} -constraints macOnly -body {
    source -rsrcid bad_id
} -returnCodes error -result {expected integer but got "bad_id"}

test source-4.3 {source error conditions} -constraints macOnly -body {
    source -rsrc rsrcName fileName extra
} -returnCodes error -result {wrong # args: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?" or "source -encoding name fileName"}

test source-4.4 {source error conditions} -constraints macOnly -body {
    source non_switch rsrcName
} -returnCodes error -result {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?" or "source -encoding name fileName"}

test source-4.5 {source error conditions} -constraints macOnly -body {
    source -bad_switch argument
} -returnCodes error -result {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?" or "source -encoding name fileName"}

 
testConstraint testWriteTextResource \
	[llength [info commands testWriteTextResource]]

test source-5.1 {source resource files} -constraints macOnly -setup {
    set sourcefile [makeFile {} bad_file]
    removeFile bad_file
} -body {
    source -rsrc rsrcName $sourcefile
} -returnCodes error -match glob -result {Error finding the file: "*bad_file".}

test source-5.2 {source resource files} -constraints macOnly -setup {
    set sourcefile [makeFile {return} source.file]
} -body {
    source -rsrc rsrcName $sourcefile
} -cleanup {
    removeFile source.file
} -returnCodes error -match glob \
  -result {Error reading the file: "*source.file".}

test source-5.3 {source resource files} -constraints {
    macOnly testWriteTextResource
} -setup {
    set msg2 unset
    set rsrcFile [makeFile {} rsrc.file]
    removeFile rsrc.file
    testWriteTextResource -rsrc rsrcName -file $rsrc.file {set msg2 ok; return}
} -body {
    set result [catch {source -rsrc rsrcName rsrc.file} msg]
    list $msg2 $result $msg
} -cleanup {
    removeFile rsrc.file
} -result [list ok 0 {}]

test source-5.4 {source resource files} -constraints {
    macOnly testWriteTextResource
} -setup {
    set msg2 unset
    set rsrsFile [makeFile {} rsrc.file]
    removeFile rsrc.file
    testWriteTextResource -rsrc fileRsrcName \
	    -file $rsrcFile {set msg2 ok; return}
} -body {
    source -rsrc fileRsrcName $rsrcFile
    set result [catch {source -rsrc fileRsrcName} msg]    
    list $msg2 $result $msg
} -cleanup {
    removeFile rsrc.file
} -result [list ok 1 {The resource "fileRsrcName" could not be loaded from application.}]

test source-5.5 {source resource files} -constraints {
    macOnly testWriteTextResource
} -setup {
    set msg2 unset
    set rsrcFile [makeFile {} rsrc.file]
    removeFile rsrc.file
    testWriteTextResource -rsrcid 200 \
	    -file $rsrcFile {set msg2 hello; set msg3 bye}
} -body {
    set result [catch {source -rsrcid 200 $rsrcFile} msg]
    list $msg2 $result $msg
} -cleanup {
    removeFile rsrc.file
} -result [list hello 0 bye]

test source-5.6 {source resource files} -constraints {
    macOnly testWriteTextResource
} -setup {
    set msg2 unset
    set rsrcFile [makeFile {} rsrc.file]
    removeFile rsrc.file
    testWriteTextResource -rsrcid 200 \
	    -file $rsrcFile {set msg2 hello; error bad; set msg3 bye}
} -body {
    set result [catch {source -rsrcid 200 rsrc.file} msg]
    list $msg2 $result $msg
} -cleanup {
    removeFile rsrc.file
} -result [list hello 1 bad]


test source-6.1 {source is binary ok} -setup {
    # Note [makeFile] writes in the system encoding.
    # [source] defaults to reading in the system encoding.
    set sourcefile [makeFile [list set x "a b\0c"] source.file]
} -body {
    set x {}
    source $sourcefile
    string length $x
} -cleanup {
    removeFile source.file
} -result 5

test source-6.2 {source skips everything after Ctrl-Z: Bug 2040} -setup {
    set sourcefile [makeFile "set x ab\32c" source.file]
} -body {
    set x {}
    source $sourcefile
    string length $x
} -cleanup {
    removeFile source.file
} -result 2

test source-7.1 {source -encoding test} -setup {
    set sourcefile [makeFile {} source.file]
    removeFile source.file
    set f [open $sourcefile w]
    fconfigure $f -encoding utf-8
    puts $f "set symbol(square-root) \u221A; set x correct"
    close $f
} -body {
    set x unset
    source -encoding utf-8 $sourcefile
    set x
} -cleanup {
    removeFile source.file
} -result correct

test source-7.2 {source -encoding test} -setup {
    # This tests for bad interactions between [source -encoding]
    # and use of the Control-Z character (\u001A) as a cross-platform
    # EOF character by [source].  Here we write out and the [source] a
    # file that contains the byte \x1A, although not the character \u001A in
    # the indicated encoding.
    set sourcefile [makeFile {} source.file]
    removeFile source.file
    set f [open $sourcefile w]
    fconfigure $f -encoding unicode
    puts $f "set symbol(square-root) \u221A; set x correct"
    close $f
} -body {
    set x unset
    source -encoding unicode $sourcefile
    set x
} -cleanup {
    removeFile source.file
} -result correct

test source-7.3 {source -encoding: syntax} -body {
    # Have to spell out the -encoding option
    source -e utf-8 no_file
} -returnCodes 1 -match glob -result {bad option*}

test source-7.4 {source -encoding: syntax} -setup {
    set sourcefile [makeFile {} source.file]
} -body {
    source -encoding no-such-encoding $sourcefile
} -cleanup {
    removeFile source.file
} -returnCodes 1 -match glob -result {unknown encoding*}

test source-7.5 {source -encoding: correct operation} -setup {
    set sourcefile [makeFile {} source.file]
    removeFile source.file
    set f [open $sourcefile w]
    fconfigure $f -encoding utf-8
    puts $f "proc \u20ac {} {return foo}"
    close $f
} -body {
    source -encoding utf-8 $sourcefile
    \u20ac
} -cleanup {
    removeFile source.file
    rename \u20ac {}
} -result foo

test source-7.6 {source -encoding: mismatch encoding error} -setup {
    set sourcefile [makeFile {} source.file]
    removeFile source.file
    set f [open $sourcefile w]
    fconfigure $f -encoding utf-8
    puts $f "proc \u20ac {} {return foo}"
    close $f
} -body {
    source -encoding ascii $sourcefile
    \u20ac
} -cleanup {
    removeFile source.file
} -returnCodes error -match glob -result {invalid command name*}

cleanupTests
}
namespace delete ::tcl::test::source
return