blob: 03b7caf74273723156d9da3e7f77aa41d3776b4a (
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
|
# This file (iOUtil.test) tests the hookable TclStat(), @@@TclAccess(),
# and @@@Tcl_OpenFileChannel, routines in the file generic/tclIOUtils.c.
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright (c) 1998 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: %Z% $Id: ioUtil.test,v 1.1 1998/06/04 12:44:44 suresh Exp $
if {[string compare test [info procs test]] == 1} then {source defs}
set unsetScript {
catch {unset testStat1(size)}
catch {unset testStat2(size)}
catch {unset testStat3(size)}
}
test stat-1.1 {TclStat: Check that none of the test procs are there.} {
catch {file stat testTclStat1%.fil testStat1} err1
catch {file stat testTclStat2%.fil testStat2} err2
catch {file stat testTclStat3%.fil testStat3} err3
list $err1 $err2 $err3
} {{couldn't stat "testTclStat1%.fil": no such file or directory} {couldn't stat "testTclStat2%.fil": no such file or directory} {couldn't stat "testTclStat3%.fil": no such file or directory}}
test stat-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} {
catch {testTclStat insert TclpStat} err1
testTclStat insert TestTclStatProc1
testTclStat insert TestTclStatProc2
testTclStat insert TestTclStatProc3
set err1
} {bad arg "insert": must be TestTclStatProc1, TestTclStatProc2, or TestTclStatProc3}
test stat-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} {
file stat testTclStat2%.fil testStat2
file stat testTclStat1%.fil testStat1
file stat testTclStat3%.fil testStat3
list $testStat2(size) $testStat1(size) $testStat3(size)
} {2345 1234 3456}
eval $unsetScript
test stat-1.4 {TclStatDeleteProc: "TclpStat" function should not be deletedable.} {
catch {testTclStat delete TclpStat} err2
set err2
} {"TclpStat": could not be deleteed}
test stat-1.5 {TclStatDeleteProc: Delete the 2nd TclStat procedure.} {
# Delete the 2nd procedure and test that it longer exists but that
# the others do actually return a result.
testTclStat delete TestTclStatProc2
file stat testTclStat1%.fil testStat1
catch {file stat testTclStat2%.fil testStat2} err3
file stat testTclStat3%.fil testStat3
list $testStat1(size) $err3 $testStat3(size)
} {1234 {couldn't stat "testTclStat2%.fil": no such file or directory} 3456}
eval $unsetScript
test stat-1.6 {TclStatDeleteProc: Delete the 1st TclStat procedure.} {
# Next delete the 1st procedure and test that only the 3rd procedure
# is the only one that exists.
testTclStat delete TestTclStatProc1
catch {file stat testTclStat1%.fil testStat1} err4
catch {file stat testTclStat2%.fil testStat2} err5
file stat testTclStat3%.fil testStat3
list $err4 $err5 $testStat3(size)
} {{couldn't stat "testTclStat1%.fil": no such file or directory} {couldn't stat "testTclStat2%.fil": no such file or directory} 3456}
eval $unsetScript
test stat-1.7 {TclStatDeleteProc: Delete the 3rd procedure & verify all are gone.} {
# Finally delete the 3rd procedure and check that none of the
# procedures exist.
testTclStat delete TestTclStatProc3
catch {file stat testTclStat1%.fil testStat1} err6
catch {file stat testTclStat2%.fil testStat2} err7
catch {file stat testTclStat3%.fil testStat3} err8
list $err6 $err7 $err8
} {{couldn't stat "testTclStat1%.fil": no such file or directory} {couldn't stat "testTclStat2%.fil": no such file or directory} {couldn't stat "testTclStat3%.fil": no such file or directory}}
eval $unsetScript
test stat-1.8 {TclStatDeleteProc: Verify that all procs have been deleted.} {
# Attempt to delete all the Stat procs. again to ensure they no longer
# exist and an error is returned.
catch {testTclStat delete TestTclStatProc1} err9
catch {testTclStat delete TestTclStatProc2} err10
catch {testTclStat delete TestTclStatProc3} err11
list $err9 $err10 $err11
} {{"TestTclStatProc1": could not be deleteed} {"TestTclStatProc2": could not be deleteed} {"TestTclStatProc3": could not be deleteed}}
eval $unsetScript
|
