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
|
#
# fstat.test
#
# Tests for the fstat command.
#---------------------------------------------------------------------------
# Copyright 1992-1999 Karl Lehenbauer and Mark Diekhans.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies. Karl Lehenbauer and
# Mark Diekhans make no representations about the suitability of this
# software for any purpose. It is provided "as is" without express or
# implied warranty.
#------------------------------------------------------------------------------
# $Id: fstat.test,v 1.3 2002/04/04 06:10:30 hobbs Exp $
#------------------------------------------------------------------------------
#
if {[cequal [info procs Test] {}]} {
source [file join [file dirname [info script]] testlib.tcl]
}
TestRemove gorp.file
set gorpFH [open gorp.file w]
puts $gorpFH "Test string"
close $gorpFH
if ![cequal $tcl_platform(platform) windows] { ;# WIN32???
chmod 0765 gorp.file
}
set gorpFH [open gorp.file r+]
test fstat-1.1 {array return} {
catch {unset stat}
fstat $gorpFH stat stat
lsort [array names stat]
} {atime ctime dev gid ino mode mtime nlink size tty type uid}
if [cequal $tcl_platform(platform) windows] {
set expect {1 13 0 file 0}
} else {
set expect {1 12 501 file 0}
}
test fstat-1.2 {array return} {
catch {unset stat}
fstat $gorpFH stat stat
list $stat(nlink) $stat(size) [expr $stat(mode)&0777] $stat(type) \
$stat(tty)
} $expect
if [cequal $tcl_platform(platform) windows] {
set expect {0 0 13}
} else {
set expect {1 1 12}
}
test fstat-1.3 {array return} {
catch {unset stat}
fstat $gorpFH stat stat
list [expr {[file mtime gorp.file] == $stat(mtime)}] \
[expr {[file atime gorp.file] == $stat(atime)}] $stat(size)
} $expect
test fstat-2.1 {keyed list returns} {
catch {unset stat}
set stat [fstat $gorpFH]
lsort [keylkeys stat]
} {atime ctime dev gid ino mode mtime nlink size tty type uid}
if [cequal $tcl_platform(platform) windows] {
set expect {1 13 0 file}
} else {
set expect {1 12 501 file}
}
test fstat-2.2 {keyed list returns} {
set stat [fstat $gorpFH]
list [keylget stat nlink] [keylget stat size] \
[expr [keylget stat mode ]&0777] [keylget stat type]
} $expect
if [cequal $tcl_platform(platform) windows] {
set expect {0 0 13} ;# Can't get times on open file.
} else {
set expect {1 1 12}
}
test fstat-2.3 {keyed list returns} {
set stat [fstat $gorpFH]
list [expr {[file mtime gorp.file] == [keylget stat mtime]}] \
[expr {[file atime gorp.file] == [keylget stat atime]}] \
[keylget stat size]
} $expect
test fstat-3.1 {individual item returns} unixOnly {
set old [fstat $gorpFH mtime]
sleep 2
puts $gorpFH "More text"
flush $gorpFH
set new [fstat $gorpFH mtime]
if {($new > $old) && ($new <= ($old+5))} {
concat OK
} else {
error "Bad mtimes: old = $old, new = $new"
}
} {OK}
test fstat-3.2 {individual item returns} {unixOnly} {
# Windows doen't really write to disk till end
set oldsize [fstat $gorpFH size]
puts $gorpFH "More text"
flush $gorpFH
expr {[fstat $gorpFH size] - $oldsize}
} 8
if [cequal $tcl_platform(platform) windows] {
set expect 11
} else {
set expect 10
}
test fstat-3.3 {individual item returns} {
set fh [open fstat.tmp w]
set oldsize [fstat $fh size]
puts $fh "More text"
close $fh
set fh [open fstat.tmp]
set diff [expr {[fstat $fh size] - $oldsize}]
close $fh
set diff
} $expect
test fstat-4.1 {type return} {unixOnly} {
set fh [open .]
set type [fstat $fh type]
close $fh
set type
} directory
test fstat-4.2 {type return} {
fstat $gorpFH type
} file
#
# Check to see that the values that are returned are at least numeric where
# expected
#
test fstat-4.3 {type return} {
set dataList {}
foreach type {dev ino mode nlink uid gid size atime mtime ctime tty
type} {
set data [fstat $gorpFH $type]
if [string match "-*" $data] {
set data [csubstr $data 1 end]
}
lappend dataList [ctype digit $data]
}
set dataList
} {1 1 1 1 1 1 1 1 1 1 1 0}
test fstat-5.1 {error handling} {
list [catch {fstat} msg] $msg
} {1 {wrong # args: fstat fileId ?item?|?stat arrayVar?}}
test fstat-5.2 {error handling} {
list [catch {fstat foo} msg] $msg
} {1 {can not find channel named "foo"}}
test fstat-5.3 {error handling} {
list [catch {fstat $gorpFH foo} msg] $msg
} {1 {Got "foo", expected one of "atime", "ctime", "dev", "gid", "ino", "mode", "mtime", "nlink", "size", "tty", "type", "uid", "remotehost", or "localhost"}}
test fstat-5.4 {error handling} {
catch {unset foo}
list [catch {fstat $gorpFH foo foo} msg] $msg
} {1 {expected item name of "stat" when using array name}}
test fstat-5.5 {error handling} {
catch {unset foo}
list [catch {fstat $gorpFH stat foo baz} msg] $msg
} {1 {wrong # args: fstat fileId ?item?|?stat arrayVar?}}
# FIX: Need localhost/remotehost tests.
catch {close $gorpFH}
TestRemove gorp.file fstat.tmp
# cleanup
::tcltest::cleanupTests
return
|
