blob: 1718aa6570dd5789d0c011e767dfd920ec917622 (
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
|
# 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.
#
# 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.7 2000/05/11 00:16:53 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
test source-1.1 {source command} {
set x "old x value"
set y "old y value"
set z "old z value"
makeFile {
set x 22
set y 33
set z 44
} source.file
source source.file
list $x $y $z
} {22 33 44}
test source-1.2 {source command} {
makeFile {list result} source.file
source source.file
} result
test source-1.3 {source command} {
set y {\ }
set fd [open source.file w]
fconfigure $fd -translation lf
puts -nonewline $fd "list a b c "
puts $fd [string index $y 0]
puts $fd "d e f"
close $fd
source source.file
} {a b c d e f}
test source-2.3 {source error conditions} {
makeFile {
set x 146
error "error in sourced file"
set y $x
} source.file
list [catch {source source.file} msg] $msg $errorInfo
} {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 source.file"}}
test source-2.4 {source error conditions} {
makeFile {break} source.file
catch {source source.file}
} 3
test source-2.5 {source error conditions} {
makeFile {continue} source.file
catch {source source.file}
} 4
test source-2.6 {source error conditions} {
normalizeMsg [list [catch {source _non_existent_} msg] $msg $errorCode]
} {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} {
makeFile {
set x new-x
return allDone
set y new-y
} source.file
set x old-x
set y old-y
set z [source source.file]
list $x $y $z
} {new-x old-y allDone}
test source-3.2 {return with special code etc.} {
makeFile {
set x new-x
return -code break "Silly result"
set y new-y
} source.file
list [catch {source source.file} msg] $msg
} {3 {Silly result}}
test source-3.3 {return with special code etc.} {
makeFile {
set x new-x
return -code error "Simulated error"
set y new-y
} source.file
list [catch {source source.file} msg] $msg $errorInfo $errorCode
} {1 {Simulated error} {Simulated error
while executing
"source source.file"} NONE}
test source-3.4 {return with special code etc.} {
makeFile {
set x new-x
return -code error -errorinfo "Simulated errorInfo stuff"
set y new-y
} source.file
list [catch {source source.file} msg] $msg $errorInfo $errorCode
} {1 {} {Simulated errorInfo stuff
invoked from within
"source source.file"} NONE}
test source-3.5 {return with special code etc.} {
makeFile {
set x new-x
return -code error -errorinfo "Simulated errorInfo stuff" \
-errorcode {a b c}
set y new-y
} source.file
list [catch {source source.file} msg] $msg $errorInfo $errorCode
} {1 {} {Simulated errorInfo stuff
invoked from within
"source source.file"} {a b c}}
# Test for the Macintosh specfic features of the source command
test source-4.1 {source error conditions} {macOnly} {
list [catch {source -rsrc _no_exist_} msg] $msg
} [list 1 "The resource \"_no_exist_\" could not be loaded from application."]
test source-4.2 {source error conditions} {macOnly} {
list [catch {source -rsrcid bad_id} msg] $msg
} [list 1 "expected integer but got \"bad_id\""]
test source-4.3 {source error conditions} {macOnly} {
list [catch {source -rsrc rsrcName fileName extra} msg] $msg
} {1 {wrong # args: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
test source-4.4 {source error conditions} {macOnly} {
list [catch {source non_switch rsrcName} msg] $msg
} {1 {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
test source-4.5 {source error conditions} {macOnly} {
list [catch {source -bad_switch argument} msg] $msg
} {1 {bad argument: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
test source-5.1 {source resource files} {macOnly} {
list [catch {source -rsrc rsrcName bad_file} msg] $msg
} [list 1 "Error finding the file: \"bad_file\"."]
test source-5.2 {source resource files} {macOnly} {
makeFile {return} source.file
list [catch {source -rsrc rsrcName source.file} msg] $msg
} [list 1 "Error reading the file: \"source.file\"."]
test source-5.3 {source resource files} {macOnly} {
testWriteTextResource -rsrc rsrcName -file rsrc.file {set msg2 ok; return}
set result [catch {source -rsrc rsrcName rsrc.file} msg]
removeFile rsrc.file
list $msg2 $result $msg
} [list ok 0 {}]
test source-5.4 {source resource files} {macOnly} {
catch {unset msg2}
testWriteTextResource -rsrc fileRsrcName -file rsrc.file {set msg2 ok; return}
source -rsrc fileRsrcName rsrc.file
set result [catch {source -rsrc fileRsrcName} msg]
removeFile rsrc.file
list $msg2 $result $msg
} [list ok 1 {The resource "fileRsrcName" could not be loaded from application.}]
test source-5.5 {source resource files} {macOnly} {
testWriteTextResource -rsrcid 200 -file rsrc.file {set msg2 hello; set msg3 bye}
set result [catch {source -rsrcid 200 rsrc.file} msg]
removeFile rsrc.file
list $msg2 $result $msg
} [list hello 0 bye]
test source-5.6 {source resource files} {macOnly} {
testWriteTextResource -rsrcid 200 -file rsrc.file {set msg2 hello; error bad; set msg3 bye}
set result [catch {source -rsrcid 200 rsrc.file} msg]
removeFile rsrc.file
list $msg2 $result $msg
} [list hello 1 bad]
test source-6.1 {source is binary ok} {
set x {}
makeFile [list set x "a b\0c"] source.file
source source.file
string length $x
} 5
test source-6.2 {source skips everything after Ctrl-Z: Bug 2040} {
set x {}
makeFile [list set x "ab\32c"] source.file
source source.file
string length $x
} 2
# cleanup
catch {::tcltest::removeFile source.file}
::tcltest::cleanupTests
return
|
