OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [iOUtil.test] - Blame information for rev 578

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
# This file (iOUtil.test) tests the hookable TclStat(), TclAccess(),
2
# and Tcl_OpenFileChannel, routines in the file generic/tclIOUtils.c.
3
# Sourcing this file into Tcl runs the tests and generates output for
4
# errors. No output means no errors were found.
5
#
6
# Copyright (c) 1998 by Scriptics Corporation.
7
#
8
# See the file "license.terms" for information on usage and redistribution
9
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
10
#
11
# RCS: @(#) $Id: iOUtil.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $
12
 
13
if {[string compare test [info procs test]] == 1} then {source defs}
14
 
15
set unsetScript {
16
    catch {unset testStat1(size)}
17
    catch {unset testStat2(size)}
18
    catch {unset testStat3(size)}
19
}
20
 
21
test stat-1.1 {TclStat: Check that none of the test procs are there.} {
22
    catch {file stat testStat1%.fil testStat1} err1
23
    catch {file stat testStat2%.fil testStat2} err2
24
    catch {file stat testStat3%.fil testStat3} err3
25
    list $err1 $err2 $err3
26
} {{couldn't stat "testStat1%.fil": no such file or directory} {couldn't stat "testStat2%.fil": no such file or directory} {couldn't stat "testStat3%.fil": no such file or directory}}
27
 
28
if {[info commands teststatproc] == {}} {
29
    puts "This application hasn't been compiled with the \"teststatproc\""
30
    puts "command, so I can't test Tcl_Stat_* etc."
31
} else {
32
test stat-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} {
33
    catch {teststatproc insert TclpStat} err1
34
    teststatproc insert TestStatProc1
35
    teststatproc insert TestStatProc2
36
    teststatproc insert TestStatProc3
37
    set err1
38
} {bad arg "insert": must be TestStatProc1, TestStatProc2, or TestStatProc3}
39
 
40
test stat-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} {
41
    file stat testStat2%.fil testStat2
42
    file stat testStat1%.fil testStat1
43
    file stat testStat3%.fil testStat3
44
 
45
    list $testStat2(size) $testStat1(size) $testStat3(size)
46
} {2345 1234 3456}
47
 
48
eval $unsetScript
49
 
50
test stat-1.4 {TclStatDeleteProc: "TclpStat" function should not be deletedable.} {
51
    catch {teststatproc delete TclpStat} err2
52
    set err2
53
} {"TclpStat": could not be deleteed}
54
 
55
test stat-1.5 {TclStatDeleteProc: Delete the 2nd TclStat procedure.} {
56
    # Delete the 2nd procedure and test that it longer exists but that
57
    #   the others do actually return a result.
58
 
59
    teststatproc delete TestStatProc2
60
    file stat testStat1%.fil testStat1
61
    catch {file stat testStat2%.fil testStat2} err3
62
    file stat testStat3%.fil testStat3
63
 
64
    list $testStat1(size) $err3 $testStat3(size)
65
} {1234 {couldn't stat "testStat2%.fil": no such file or directory} 3456}
66
 
67
eval $unsetScript
68
 
69
test stat-1.6 {TclStatDeleteProc: Delete the 1st TclStat procedure.} {
70
    # Next delete the 1st procedure and test that only the 3rd procedure
71
    #   is the only one that exists.
72
 
73
    teststatproc delete TestStatProc1
74
    catch {file stat testStat1%.fil testStat1} err4
75
    catch {file stat testStat2%.fil testStat2} err5
76
    file stat testStat3%.fil testStat3
77
 
78
    list $err4 $err5 $testStat3(size)
79
} {{couldn't stat "testStat1%.fil": no such file or directory} {couldn't stat "testStat2%.fil": no such file or directory} 3456}
80
 
81
eval $unsetScript
82
 
83
test stat-1.7 {TclStatDeleteProc: Delete the 3rd procedure & verify all are gone.} {
84
    # Finally delete the 3rd procedure and check that none of the
85
    #   procedures exist.
86
 
87
    teststatproc delete TestStatProc3
88
    catch {file stat testStat1%.fil testStat1} err6
89
    catch {file stat testStat2%.fil testStat2} err7
90
    catch {file stat testStat3%.fil testStat3} err8
91
 
92
    list $err6 $err7 $err8
93
} {{couldn't stat "testStat1%.fil": no such file or directory} {couldn't stat "testStat2%.fil": no such file or directory} {couldn't stat "testStat3%.fil": no such file or directory}}
94
 
95
eval $unsetScript
96
 
97
test stat-1.8 {TclStatDeleteProc: Verify that all procs have been deleted.} {
98
    # Attempt to delete all the Stat procs. again to ensure they no longer
99
    #   exist and an error is returned.
100
 
101
    catch {teststatproc delete TestStatProc1} err9
102
    catch {teststatproc delete TestStatProc2} err10
103
    catch {teststatproc delete TestStatProc3} err11
104
 
105
    list $err9 $err10 $err11
106
} {{"TestStatProc1": could not be deleteed} {"TestStatProc2": could not be deleteed} {"TestStatProc3": could not be deleteed}}
107
}
108
 
109
eval $unsetScript
110
 
111
 
112
test access-1.1 {TclAccess: Check that none of the test procs are there.} {
113
    catch {file exists testAccess1%.fil} err1
114
    catch {file exists testAccess2%.fil} err2
115
    catch {file exists testAccess3%.fil} err3
116
    list $err1 $err2 $err3
117
} {0 0 0}
118
 
119
if {[info commands testaccessproc] == {}} {
120
    puts "This application hasn't been compiled with the \"testaccessproc\""
121
    puts "command, so I can't test Tcl_Access_* etc."
122
} else {
123
test access-1.2 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.} {
124
    catch {testaccessproc insert TclpAccess} err1
125
    testaccessproc insert TestAccessProc1
126
    testaccessproc insert TestAccessProc2
127
    testaccessproc insert TestAccessProc3
128
    set err1
129
} {bad arg "insert": must be TestAccessProc1, TestAccessProc2, or TestAccessProc3}
130
 
131
test access-1.3 {TclAccess: Use "file access ?" to invoke each procedure.} {
132
    list \
133
        [file exists testAccess2%.fil] \
134
                [file exists testAccess1%.fil] \
135
                [file exists testAccess3%.fil]
136
} {1 1 1}
137
 
138
test access-1.4 {TclAccessDeleteProc: "TclpAccess" function should not be deletedable.} {
139
    catch {testaccessproc delete TclpAccess} err2
140
    set err2
141
} {"TclpAccess": could not be deleteed}
142
 
143
test accesst-1.5 {TclAccessDeleteProc: Delete the 2nd TclAccess procedure.} {
144
    # Delete the 2nd procedure and test that it longer exists but that
145
    #   the others do actually return a result.
146
 
147
    testaccessproc delete TestAccessProc2
148
    set res1 [file exists testAccess1%.fil]
149
    catch {file exists testAccess2%.fil} err3
150
    set res2 [file exists testAccess3%.fil]
151
 
152
    list $res1 $err3 $res2
153
} {1 0 1}
154
 
155
test access-1.6 {TclAccessDeleteProc: Delete the 1st TclAccess procedure.} {
156
    # Next delete the 1st procedure and test that only the 3rd procedure
157
    #   is the only one that exists.
158
 
159
    testaccessproc delete TestAccessProc1
160
    catch {file exists testAccess1%.fil} err4
161
    catch {file exists testAccess2%.fil} err5
162
    set res3 [file exists testAccess3%.fil]
163
 
164
    list $err4 $err5 $res3
165
} {0 0 1}
166
 
167
test access-1.7 {TclAccessDeleteProc: Delete the 3rd procedure & verify all are gone.} {
168
    # Finally delete the 3rd procedure and check that none of the
169
    #   procedures exist.
170
 
171
    testaccessproc delete TestAccessProc3
172
    catch {file exists testAccess1%.fil} err6
173
    catch {file exists testAccess2%.fil} err7
174
    catch {file exists testAccess3%.fil} err8
175
 
176
    list $err6 $err7 $err8
177
} {0 0 0}
178
 
179
test access-1.8 {TclAccessDeleteProc: Verify that all procs have been deleted.} {
180
    # Attempt to delete all the Access procs. again to ensure they no longer
181
    #   exist and an error is returned.
182
 
183
    catch {testaccessproc delete TestAccessProc1} err9
184
    catch {testaccessproc delete TestAccessProc2} err10
185
    catch {testaccessproc delete TestAccessProc3} err11
186
 
187
    list $err9 $err10 $err11
188
} {{"TestAccessProc1": could not be deleteed} {"TestAccessProc2": could not be deleteed} {"TestAccessProc3": could not be deleteed}}
189
}
190
 
191
test openfilechannel-1.1 {TclOpenFileChannel: Check that none of the test procs are there.} {
192
    catch {file exists __testOpenFileChannel1%__.fil} err1
193
    catch {file exists __testOpenFileChannel2%__.fil} err2
194
    catch {file exists __testOpenFileChannel3%__.fil} err3
195
    catch {file exists __testOpenFileChannel1%__.fil} err4
196
    catch {file exists __testOpenFileChannel2%__.fil} err5
197
    catch {file exists __testOpenFileChannel3%__.fil} err6
198
    list $err1 $err2 $err3 $err4 $err5 $err6
199
} {0 0 0 0 0 0}
200
 
201
if {[info commands testopenfilechannelproc] == {}} {
202
    puts "This application hasn't been compiled with the \"testopenfilechannelproc\""
203
    puts "command, so I can't test Tcl_OpenFileChannelInsert"
204
} else {
205
test openfilechannel-1.2 {TclOpenFileChannelInsertProc: Insert the 3 test TclOpenFileChannel_ procedures.} {
206
    catch {testopenfilechannelproc insert TclpOpenFileChannel} err1
207
    testopenfilechannelproc insert TestOpenFileChannelProc1
208
    testopenfilechannelproc insert TestOpenFileChannelProc2
209
    testopenfilechannelproc insert TestOpenFileChannelProc3
210
    set err1
211
} {bad arg "insert": must be TestOpenFileChannelProc1, TestOpenFileChannelProc2, or TestOpenFileChannelProc3}
212
 
213
test openfilechannel-1.3 {TclOpenFileChannel: Use "file openfilechannel ?" to invoke each procedure.} {
214
        close [open __testOpenFileChannel1%__.fil w]
215
        close [open __testOpenFileChannel2%__.fil w]
216
        close [open __testOpenFileChannel3%__.fil w]
217
 
218
        catch {
219
                close [open testOpenFileChannel1%.fil r]
220
                close [open testOpenFileChannel2%.fil r]
221
                close [open testOpenFileChannel3%.fil r]
222
        } err
223
 
224
        file delete __testOpenFileChannel1%__.fil
225
        file delete __testOpenFileChannel2%__.fil
226
        file delete __testOpenFileChannel3%__.fil
227
 
228
        set err
229
} {}
230
 
231
test openfilechannel-1.4 {TclOpenFileChannelDeleteProc: "TclpOpenFileChannel" function should not be deletedable.} {
232
    catch {testopenfilechannelproc delete TclpOpenFileChannel} err2
233
    set err2
234
} {"TclpOpenFileChannel": could not be deleteed}
235
 
236
test openfilechannelt-1.5 {TclOpenFileChannelDeleteProc: Delete the 2nd TclOpenFileChannel procedure.} {
237
    # Delete the 2nd procedure and test that it longer exists but that
238
    #   the others do actually return a result.
239
 
240
    testopenfilechannelproc delete TestOpenFileChannelProc2
241
 
242
        close [open __testOpenFileChannel1%__.fil w]
243
        close [open __testOpenFileChannel3%__.fil w]
244
 
245
        catch {
246
                close [open testOpenFileChannel1%.fil r]
247
                catch {close [open testOpenFileChannel2%.fil r]}
248
                close [open testOpenFileChannel3%.fil r]
249
        } err3
250
 
251
        file delete __testOpenFileChannel1%__.fil
252
        file delete __testOpenFileChannel3%__.fil
253
 
254
    set err3
255
} {}
256
 
257
test openfilechannel-1.6 {TclOpenFileChannelDeleteProc: Delete the 1st TclOpenFileChannel procedure.} {
258
    # Next delete the 1st procedure and test that only the 3rd procedure
259
    #   is the only one that exists.
260
 
261
    testopenfilechannelproc delete TestOpenFileChannelProc1
262
 
263
        close [open __testOpenFileChannel3%__.fil w]
264
 
265
        catch {
266
                catch {close [open testOpenFileChannel1%.fil r]}
267
                catch {close [open testOpenFileChannel2%.fil r]}
268
                close [open testOpenFileChannel3%.fil r]
269
        } err4
270
 
271
        file delete __testOpenFileChannel3%__.fil
272
 
273
    set err4
274
} {}
275
 
276
test openfilechannel-1.7 {TclOpenFileChannelDeleteProc: Delete the 3rd procedure & verify all are gone.} {
277
    # Finally delete the 3rd procedure and check that none of the
278
    #   procedures exist.
279
 
280
    testopenfilechannelproc delete TestOpenFileChannelProc3
281
        catch {
282
                catch [open testOpenFileChannel1%.fil r]
283
                catch [open testOpenFileChannel2%.fil r]
284
                catch [open testOpenFileChannel3%.fil r]
285
        } err5
286
 
287
    set err5
288
} {1}
289
 
290
test openfilechannel-1.8 {TclOpenFileChannelDeleteProc: Verify that all procs have been deleted.} {
291
    # Attempt to delete all the OpenFileChannel procs. again to ensure they no longer
292
    #   exist and an error is returned.
293
 
294
    catch {testopenfilechannelproc delete TestOpenFileChannelProc1} err9
295
    catch {testopenfilechannelproc delete TestOpenFileChannelProc2} err10
296
    catch {testopenfilechannelproc delete TestOpenFileChannelProc3} err11
297
 
298
    list $err9 $err10 $err11
299
} {{"TestOpenFileChannelProc1": could not be deleteed} {"TestOpenFileChannelProc2": could not be deleteed} {"TestOpenFileChannelProc3": could not be deleteed}}
300
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.