aboutsummaryrefslogtreecommitdiffstats
path: root/contrib/tcl/tests/resource.test
blob: e815ef8c494d792a42dc2a99714c33d850ee9a39 (plain) (blame)
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
# Commands covered:  resource
#
# 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) 1996-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) resource.test 1.8 97/11/06 12:36:32

# Only run this test on Macintosh systems
if {$tcl_platform(platform) != "macintosh"} {
    return
}
if {[string compare test [info procs test]] == 1} then {source defs}

test resource-1.1 {resource tests} {
    list [catch {resource} msg] $msg
} {1 {wrong # args: should be "resource option ?arg ...?"}}
test resource-1.2 {resource tests} {
    list [catch {resource _bad_} msg] $msg
} {1 {bad option "_bad_": must be close, delete, files, list, open, read, types, or write}}

# resource open & close tests
test resource-2.1 {resource open & close tests} {
    list [catch {resource open} msg] $msg
} {1 {wrong # args: should be "resource open fileName ?permissions?"}}
test resource-2.2 {resource open & close tests} {
    list [catch {resource open resource.test r extraArg} msg] $msg
} {1 {wrong # args: should be "resource open fileName ?permissions?"}}
test resource-2.3 {resource open & close tests} {
    list [catch {resource open resource.test bad_perms} msg] $msg
} {1 {illegal access mode "bad_perms"}}
test resource-2.4 {resource open & close tests} {
    list [catch {resource open _bad_file_} msg] $msg
} {1 {file does not exist}}
test resource-2.5 {resource open & close tests} {
    testWriteTextResource -rsrc fileRsrcName -file rsrc.file  {error "don't source me"}
    set id [resource open rsrc.file]
    resource close $id
    file delete rsrc.file
} {}
test resource-2.6 {resource open & close tests} {
    catch {file delete rsrc.file}
    testWriteTextResource -rsrc fileRsrcName -file rsrc.file  {error "don't source me"}
    set id [resource open rsrc.file]
    set result [string compare [resource open rsrc.file] $id]
    resource close $id
    file delete rsrc.file
    set result
} {0}
test resource-2.7 {resource open & close tests} {
    list [catch {resource close} msg] $msg
} {1 {wrong # args: should be "resource close resourceRef"}}
test resource-2.8 {resource open & close tests} {
    list [catch {resource close foo bar} msg] $msg
} {1 {wrong # args: should be "resource close resourceRef"}}
test resource-2.9 {resource open & close tests} {
    list [catch {resource close _bad_resource_} msg] $msg
} {1 {invalid resource file reference "_bad_resource_"}}
test resource-2.10 {resource open & close tests} {
    set result [catch {resource close System} mssg]
    lappend result $mssg
} {1 {can't close "System" resource file}}
test resource-2.11 {resource open & close tests} {
    set result [catch {resource close application} mssg]
    lappend result $mssg
} {1 {can't close "application" resource file}}

# Tests for listing resources
test resource-3.1 {resource list tests} {
    list [catch {resource list} msg] $msg
} {1 {wrong # args: should be "resource list resourceType ?resourceRef?"}}
test resource-3.2 {resource list tests} {
    list [catch {resource list _bad_type_} msg] $msg
} {1 {expected Macintosh OS type but got "_bad_type_"}}
test resource-3.3 {resource list tests} {
    list [catch {resource list TEXT _bad_ref_} msg] $msg
} {1 {invalid resource file reference "_bad_ref_"}}
test resource-3.4 {resource list tests} {
    list [catch {resource list TEXT _bad_ref_ extraArg} msg] $msg
} {1 {wrong # args: should be "resource list resourceType ?resourceRef?"}}
test resource-3.5 {resource list tests} {
    catch {file delete rsrc.file}
    testWriteTextResource -rsrc fileRsrcName -file rsrc.file  {error "don't source me"}
    set id [resource open rsrc.file]
    catch "resource list TEXT $id" result
    resource close $id
    set result
} {fileRsrcName}
test resource-3.6 {resource list tests} {
    # There should not be any resource of this type
    resource list XXXX
} {}
test resource-3.7 {resource list tests} {
    set resourceList [resource list STR#]
    if {[lsearch $resourceList {Tcl Environment Variables}] == -1} {
        set result {couldn't find resource that should exist}
    } else {
        set result ok
    }
} {ok}

# Tests for reading resources
test resource-4.1 {resource read tests} {
    list [catch {resource read} msg] $msg
} {1 {wrong # args: should be "resource read resourceType resourceId ?resourceRef?"}}
test resource-4.2 {resource read tests} {
    list [catch {resource read TEXT} msg] $msg
} {1 {wrong # args: should be "resource read resourceType resourceId ?resourceRef?"}}
test resource-4.3 {resource read tests} {
    list [catch {resource read STR# {_non_existant_resource_}} msg] $msg
} {1 {could not load resource}}
test resource-4.4 {resource read tests} {
    # The following resource should exist and load OK without error
    catch {resource read STR# {Tcl Environment Variables}}
} {0}

# Tests for getting resource types
test resource-5.1 {resource types tests} {
    list [catch {resource types _bad_ref_} msg] $msg
} {1 {invalid resource file reference "_bad_ref_"}}
test resource-5.2 {resource types tests} {
    list [catch {resource types _bad_ref_ extraArg} msg] $msg
} {1 {wrong # args: should be "resource types ?resourceRef?"}}
test resource-5.3 {resource types tests} {
    # This should never cause an error
    catch {resource types}
} {0}
test resource-5.4 {resource types tests} {
    testWriteTextResource -rsrc fileRsrcName -file rsrc.file  {error "don't source me"}
    set id [resource open rsrc.file]
    set result [resource types $id]
    resource close $id
    set result
} {TEXT}

# resource write tests
test resource-6.1 {resource write tests} {
    list [catch {resource write} msg] $msg
} {1 {wrong # args: should be "resource write ?-id resourceId? ?-name resourceName? ?-file resourceRef? ?-force? resourceType data"}}
test resource-6.2 {resource write tests} {
    list [catch {resource write _bad_type_ data} msg] $msg
} {1 {expected Macintosh OS type but got "_bad_type_"}}
test resource-6.3 {resource write tests} {
    catch {file delete rsrc2.file}
    set id [resource open rsrc2.file w]
    resource close $id
    set id [resource open rsrc2.file r]
    set result [catch {resource write -file $id -name Hello TEXT foo} errMsg]
    lappend result [string compare $errMsg "cannot write to resource file \"$id\", it was opened read only"]
    lappend result [lsearch [resource list TEXT $id] Hello]
    resource close $id
    file delete rsrc2.file
    set result   
} {1 0 -1}
test resource-6.4 {resource write tests} {
    catch {file delete rsrc2.file}
    set id [resource open rsrc2.file w]
    resource write -file $id -name Hello TEXT {set x "our test data"}
    source -rsrc Hello rsrc2.file
    resource close $id
    file delete rsrc2.file
    set x
} {our test data}
test resource-6.5 {resource write tests} {
    catch {file delete rsrc2.file}
    set id [resource open rsrc2.file w]
    resource write -file $id -id 256 TEXT {HAHAHAHAHAHAHA}
    set result [catch {resource write -file $id -id 256 TEXT {HOHOHOHOHOHO}} mssg]
    resource close $id
    file delete rsrc2.file
    lappend result $mssg
} {1 {the resource 256 already exists, use "-force" to overwrite it.}}
test resource-6.6 {resource write tests} {
    catch {file delete rsrc2.file}
    testWriteTextResource -rsrc fileRsrcName -rsrcid 256  -file rsrc2.file  -protected {error "don't tread on me"}
    set id [resource open rsrc2.file w]
    set result [catch {resource write -id 256 -force -file $id TEXT {NAHNAHNANAHNAH}} mssg] 
    resource close $id
    file delete rsrc2.file
    lappend result $mssg
} {1 {could not write resource id 256 of type TEXT, it was protected.}}
test resource-6.7 {resource write tests} {
    catch {file delete rsrc2.file}
    set id [resource open rsrc2.file w]
    resource write -file $id -id 256 -name FOO TEXT {set x [list "our first test data"]}
    resource write -file $id -id 256 -name BAR -force TEXT {set x [list "our second test data"]}
    source -rsrcid 256 rsrc2.file
    lappend x [resource list TEXT $id]
    resource close $id
    file delete rsrc2.file
    set x
} {{our second test data} BAR}

#Tests for listing open resource files
test resource-7.1 {resource file tests} {
    catch {resource files foo bar} mssg
    set mssg
} {wrong # args: should be "resource files ?resourceId?"}
test resource-7.2 {resource file tests} {
    catch {file delete rsrc2.file}
    set rsrcFiles [resource files]
    set id [resource open rsrc2.file w]
    set result [string compare $rsrcFiles [lrange [resource files] 1 end]]
    lappend result [string compare $id [lrange [resource files] 0 0]]
    resource close $id
    file delete rsrc2.file
    set result
} {0 0}
test resource-7.3 {resource file tests} {
    set result 0
    foreach file [resource files] {
        if {[catch {resource types $file}] != 0} {
            set result 1
        }
    }
    set result
} {0}
test resource-7.4 {resource file tests} {
    catch {resource files __NO_SUCH_RESOURCE__} mssg
    set mssg
} {invalid resource file reference "__NO_SUCH_RESOURCE__"}
test resource-7.5 {resource file tests} {
    set sys [resource files System]
    string compare $sys [file join $env(SYS_FOLDER) System]
} {0}
test resource-7.6 {resource file tests} {
    set app [resource files application]
    string compare $app [info nameofexecutable]
} {0}

#Tests for the resource delete command
test resource-8.1 {resource delete tests} {
    list [catch {resource delete} msg] $msg
} {1 {wrong # args: should be "resource delete ?-id resourceId? ?-name resourceName? ?-file resourceRef? resourceType"}}
test resource-8.2 {resource delete tests} {
    list [catch {resource delete TEXT} msg] $msg
} {1 {you must specify either "-id" or "-name" or both to "resource delete"}}
test resource-8.3 {resource delete tests} {
    set result [catch {resource delete -file ffffff -id 128 TEXT} mssg]
    lappend result $mssg    
} {1 {invalid resource file reference "ffffff"}}    
test resource-8.4 {resource delete tests} {
    catch {file delete rsrc2.file}
    testWriteTextResource -rsrc fileRsrcName -rsrcid 128 -file rsrc2.file {Some stuff}
    set id [resource open rsrc2.file r]
    set result [catch {resource delete -id 128 -file $id TEXT} mssg]
    resource close $id
    file delete rsrc2.file
    lappend result [string compare $mssg "cannot delete from resource file \"$id\", it was opened read only"]   
} {1 0}
test resource-8.5 {resource delete tests} {
    catch {file delete rsrc2.file}
    testWriteTextResource -rsrc fileRsrcName -rsrcid 128 -file rsrc2.file {Some stuff}
    set id [resource open rsrc2.file w]
    set result [catch {resource delete -id 128 -file $id _bad_type_} mssg]
    resource close $id
    file delete rsrc2.file
    lappend result $mssg
} {1 {expected Macintosh OS type but got "_bad_type_"}}
test resource-8.5 {resource delete tests} {
    catch {file delete rsrc2.file}
    set id [resource open rsrc2.file w]
    set result [catch {resource delete -id 128 -file $id TEXT} mssg]
    resource close $id
    file delete rsrc2.file
    lappend result $mssg
} {1 {resource not found}}
test resource-8.6 {resource delete tests} {
    catch {file delete rsrc2.file}
    set id [resource open rsrc2.file w]
    set result [catch {resource delete -name foo -file $id TEXT} mssg]
    resource close $id
    file delete rsrc2.file
    lappend result $mssg
} {1 {resource not found}}
test resource-8.7 {resource delete tests} {
    catch {file delete rsrc2.file}
    set id [resource open rsrc2.file w]
    resource write -file $id -name foo -id 128 TEXT {some stuff}
    resource write -file $id -name bar -id 129 TEXT {some stuff}
    set result [catch {resource delete -name foo -id 129 -file $id TEXT} mssg]
    resource close $id
    file delete rsrc2.file
    lappend result $mssg
} {1 {"-id" and "-name" values do not point to the same resource}}
test resource-8.8 {resource delete tests} {
    catch {file delete rsrc2.file}
    testWriteTextResource -rsrc fileRsrcName -rsrcid 256  -file rsrc2.file  -protected {error "don't tread on me"}
    set id [resource open rsrc2.file w]
    set result [catch {resource delete -id 256 -file $id TEXT } mssg] 
    resource close $id
    file delete rsrc2.file
    lappend result $mssg
} {1 {resource cannot be deleted: it is protected.}}
test resource-8.9 {resource delete tests} {
    catch {file delete rsrc2.file}
    testWriteTextResource -rsrc fileRsrcName -rsrcid 128 -file rsrc2.file {Some stuff}
    set id [resource open rsrc2.file w]
    set result [resource list TEXT $id]
    resource delete -id 128 -file $id TEXT
    lappend result [resource list TEXT $id]
    resource close $id
    file delete rsrc2.file
    set result
} {fileRsrcName {}}
    
# Tests for the Mac version of the source command
catch {file delete rsrc.file}
testWriteTextResource -rsrc fileRsrcName -rsrcid 128 \
    -file rsrc.file  {set rsrc_foo 1}
test resource-9.1 {source command} {
    catch {unset rsrc_foo}
    source -rsrc fileRsrcName rsrc.file
    list [catch {set rsrc_foo} msg] $msg
} {0 1}
test resource-9.2 {source command} {
    catch {unset rsrc_foo}
    list [catch {source -rsrc no_resource rsrc.file} msg] $msg
} {1 {The resource "no_resource" could not be loaded from rsrc.file.}}
test resource-9.3 {source command} {
    catch {unset rsrc_foo}
    source -rsrcid 128 rsrc.file
    list [catch {set rsrc_foo} msg] $msg
} {0 1}
test resource-9.4 {source command} {
    catch {unset rsrc_foo}
    list [catch {source -rsrcid bad_int rsrc.file} msg] $msg
} {1 {expected integer but got "bad_int"}}
test resource-9.5 {source command} {
    catch {unset rsrc_foo}
    list [catch {source -rsrcid 100 rsrc.file} msg] $msg
} {1 {The resource "ID=100" could not be loaded from rsrc.file.}}

# Clean up and return
catch {file delete rsrc.file}
return