[25] | 1 | # 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-1999 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.19 2007/12/13 15:26:06 dgp Exp $ |
---|
| 12 | |
---|
| 13 | if {[lsearch [namespace children] ::tcltest] == -1} { |
---|
| 14 | package require tcltest 2 |
---|
| 15 | namespace import -force ::tcltest::* |
---|
| 16 | } |
---|
| 17 | |
---|
| 18 | testConstraint testopenfilechannelproc \ |
---|
| 19 | [llength [info commands testopenfilechannelproc]] |
---|
| 20 | testConstraint testaccessproc [llength [info commands testaccessproc]] |
---|
| 21 | testConstraint teststatproc [llength [info commands teststatproc]] |
---|
| 22 | |
---|
| 23 | set unsetScript { |
---|
| 24 | catch {unset testStat1(size)} |
---|
| 25 | catch {unset testStat2(size)} |
---|
| 26 | catch {unset testStat3(size)} |
---|
| 27 | } |
---|
| 28 | |
---|
| 29 | test ioUtil-1.1 {TclStat: Check that none of the test procs are there.} {} { |
---|
| 30 | catch {file stat testStat1%.fil testStat1} err1 |
---|
| 31 | catch {file stat testStat2%.fil testStat2} err2 |
---|
| 32 | catch {file stat testStat3%.fil testStat3} err3 |
---|
| 33 | list $err1 $err2 $err3 |
---|
| 34 | } {{could not read "testStat1%.fil": no such file or directory} {could not read "testStat2%.fil": no such file or directory} {could not read "testStat3%.fil": no such file or directory}} |
---|
| 35 | |
---|
| 36 | test ioUtil-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} {teststatproc} { |
---|
| 37 | catch {teststatproc insert TclpStat} err1 |
---|
| 38 | teststatproc insert TestStatProc1 |
---|
| 39 | teststatproc insert TestStatProc2 |
---|
| 40 | teststatproc insert TestStatProc3 |
---|
| 41 | set err1 |
---|
| 42 | } {bad arg "insert": must be TestStatProc1, TestStatProc2, or TestStatProc3} |
---|
| 43 | |
---|
| 44 | test ioUtil-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} {teststatproc} { |
---|
| 45 | file stat testStat2%.fil testStat2 |
---|
| 46 | file stat testStat1%.fil testStat1 |
---|
| 47 | file stat testStat3%.fil testStat3 |
---|
| 48 | |
---|
| 49 | list $testStat2(size) $testStat1(size) $testStat3(size) |
---|
| 50 | } {2345 1234 3456} |
---|
| 51 | |
---|
| 52 | eval $unsetScript |
---|
| 53 | |
---|
| 54 | test ioUtil-1.4 {TclStatDeleteProc: "TclpStat" function should not be deletable.} {teststatproc} { |
---|
| 55 | catch {teststatproc delete TclpStat} err2 |
---|
| 56 | set err2 |
---|
| 57 | } {"TclpStat": could not be deleteed} |
---|
| 58 | |
---|
| 59 | test ioUtil-1.5 {TclStatDeleteProc: Delete the 2nd TclStat procedure.} {teststatproc} { |
---|
| 60 | # Delete the 2nd procedure and test that it longer exists but that |
---|
| 61 | # the others do actually return a result. |
---|
| 62 | |
---|
| 63 | teststatproc delete TestStatProc2 |
---|
| 64 | file stat testStat1%.fil testStat1 |
---|
| 65 | catch {file stat testStat2%.fil testStat2} err3 |
---|
| 66 | file stat testStat3%.fil testStat3 |
---|
| 67 | |
---|
| 68 | list $testStat1(size) $err3 $testStat3(size) |
---|
| 69 | } {1234 {could not read "testStat2%.fil": no such file or directory} 3456} |
---|
| 70 | |
---|
| 71 | eval $unsetScript |
---|
| 72 | |
---|
| 73 | test ioUtil-1.6 {TclStatDeleteProc: Delete the 1st TclStat procedure.} {teststatproc} { |
---|
| 74 | # Next delete the 1st procedure and test that only the 3rd procedure |
---|
| 75 | # is the only one that exists. |
---|
| 76 | |
---|
| 77 | teststatproc delete TestStatProc1 |
---|
| 78 | catch {file stat testStat1%.fil testStat1} err4 |
---|
| 79 | catch {file stat testStat2%.fil testStat2} err5 |
---|
| 80 | file stat testStat3%.fil testStat3 |
---|
| 81 | |
---|
| 82 | list $err4 $err5 $testStat3(size) |
---|
| 83 | } {{could not read "testStat1%.fil": no such file or directory} {could not read "testStat2%.fil": no such file or directory} 3456} |
---|
| 84 | |
---|
| 85 | eval $unsetScript |
---|
| 86 | |
---|
| 87 | test ioUtil-1.7 {TclStatDeleteProc: Delete the 3rd procedure & verify all are gone.} {teststatproc} { |
---|
| 88 | # Finally delete the 3rd procedure and check that none of the |
---|
| 89 | # procedures exist. |
---|
| 90 | |
---|
| 91 | teststatproc delete TestStatProc3 |
---|
| 92 | catch {file stat testStat1%.fil testStat1} err6 |
---|
| 93 | catch {file stat testStat2%.fil testStat2} err7 |
---|
| 94 | catch {file stat testStat3%.fil testStat3} err8 |
---|
| 95 | |
---|
| 96 | list $err6 $err7 $err8 |
---|
| 97 | } {{could not read "testStat1%.fil": no such file or directory} {could not read "testStat2%.fil": no such file or directory} {could not read "testStat3%.fil": no such file or directory}} |
---|
| 98 | |
---|
| 99 | eval $unsetScript |
---|
| 100 | |
---|
| 101 | test ioUtil-1.8 {TclStatDeleteProc: Verify that all procs have been deleted.} {teststatproc} { |
---|
| 102 | # Attempt to delete all the Stat procs. again to ensure they no longer |
---|
| 103 | # exist and an error is returned. |
---|
| 104 | |
---|
| 105 | catch {teststatproc delete TestStatProc1} err9 |
---|
| 106 | catch {teststatproc delete TestStatProc2} err10 |
---|
| 107 | catch {teststatproc delete TestStatProc3} err11 |
---|
| 108 | |
---|
| 109 | list $err9 $err10 $err11 |
---|
| 110 | } {{"TestStatProc1": could not be deleteed} {"TestStatProc2": could not be deleteed} {"TestStatProc3": could not be deleteed}} |
---|
| 111 | |
---|
| 112 | eval $unsetScript |
---|
| 113 | |
---|
| 114 | test ioUtil-1.9 {TclAccess: Check that none of the test procs are there.} { |
---|
| 115 | catch {file exists testAccess1%.fil} err1 |
---|
| 116 | catch {file exists testAccess2%.fil} err2 |
---|
| 117 | catch {file exists testAccess3%.fil} err3 |
---|
| 118 | list $err1 $err2 $err3 |
---|
| 119 | } {0 0 0} |
---|
| 120 | |
---|
| 121 | test ioUtil-1.10 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.} {testaccessproc} { |
---|
| 122 | catch {testaccessproc insert TclpAccess} err1 |
---|
| 123 | testaccessproc insert TestAccessProc1 |
---|
| 124 | testaccessproc insert TestAccessProc2 |
---|
| 125 | testaccessproc insert TestAccessProc3 |
---|
| 126 | set err1 |
---|
| 127 | } {bad arg "insert": must be TestAccessProc1, TestAccessProc2, or TestAccessProc3} |
---|
| 128 | |
---|
| 129 | test ioUtil-2.3 {TclAccess: Use "file access ?" to invoke each procedure.} {testaccessproc} { |
---|
| 130 | list [file exists testAccess2%.fil] \ |
---|
| 131 | [file exists testAccess1%.fil] \ |
---|
| 132 | [file exists testAccess3%.fil] |
---|
| 133 | } {1 1 1} |
---|
| 134 | |
---|
| 135 | test ioUtil-2.4 {TclAccessDeleteProc: "TclpAccess" function should not be deletable.} {testaccessproc} { |
---|
| 136 | catch {testaccessproc delete TclpAccess} err2 |
---|
| 137 | set err2 |
---|
| 138 | } {"TclpAccess": could not be deleteed} |
---|
| 139 | |
---|
| 140 | test ioUtil-2.5 {TclAccessDeleteProc: Delete the 2nd TclAccess procedure.} {testaccessproc} { |
---|
| 141 | # Delete the 2nd procedure and test that it longer exists but that |
---|
| 142 | # the others do actually return a result. |
---|
| 143 | |
---|
| 144 | testaccessproc delete TestAccessProc2 |
---|
| 145 | set res1 [file exists testAccess1%.fil] |
---|
| 146 | catch {file exists testAccess2%.fil} err3 |
---|
| 147 | set res2 [file exists testAccess3%.fil] |
---|
| 148 | |
---|
| 149 | list $res1 $err3 $res2 |
---|
| 150 | } {1 0 1} |
---|
| 151 | |
---|
| 152 | test ioUtil-2.6 {TclAccessDeleteProc: Delete the 1st TclAccess procedure.} {testaccessproc} { |
---|
| 153 | # Next delete the 1st procedure and test that only the 3rd procedure |
---|
| 154 | # is the only one that exists. |
---|
| 155 | |
---|
| 156 | testaccessproc delete TestAccessProc1 |
---|
| 157 | catch {file exists testAccess1%.fil} err4 |
---|
| 158 | catch {file exists testAccess2%.fil} err5 |
---|
| 159 | set res3 [file exists testAccess3%.fil] |
---|
| 160 | |
---|
| 161 | list $err4 $err5 $res3 |
---|
| 162 | } {0 0 1} |
---|
| 163 | |
---|
| 164 | test ioUtil-2.7 {TclAccessDeleteProc: Delete the 3rd procedure & verify all are gone.} {testaccessproc} { |
---|
| 165 | # Finally delete the 3rd procedure and check that none of the |
---|
| 166 | # procedures exist. |
---|
| 167 | |
---|
| 168 | testaccessproc delete TestAccessProc3 |
---|
| 169 | catch {file exists testAccess1%.fil} err6 |
---|
| 170 | catch {file exists testAccess2%.fil} err7 |
---|
| 171 | catch {file exists testAccess3%.fil} err8 |
---|
| 172 | |
---|
| 173 | list $err6 $err7 $err8 |
---|
| 174 | } {0 0 0} |
---|
| 175 | |
---|
| 176 | test ioUtil-2.8 {TclAccessDeleteProc: Verify that all procs have been deleted.} {testaccessproc} { |
---|
| 177 | # Attempt to delete all the Access procs. again to ensure they no longer |
---|
| 178 | # exist and an error is returned. |
---|
| 179 | |
---|
| 180 | catch {testaccessproc delete TestAccessProc1} err9 |
---|
| 181 | catch {testaccessproc delete TestAccessProc2} err10 |
---|
| 182 | catch {testaccessproc delete TestAccessProc3} err11 |
---|
| 183 | |
---|
| 184 | list $err9 $err10 $err11 |
---|
| 185 | } {{"TestAccessProc1": could not be deleteed} {"TestAccessProc2": could not be deleteed} {"TestAccessProc3": could not be deleteed}} |
---|
| 186 | |
---|
| 187 | # Some of the following tests require a writable current directory |
---|
| 188 | set oldpwd [pwd] |
---|
| 189 | cd [temporaryDirectory] |
---|
| 190 | |
---|
| 191 | test ioUtil-3.1 {TclOpenFileChannel: Check that none of the test procs are there.} {testopenfilechannelproc} { |
---|
| 192 | catch {file delete -force {*}[glob *testOpenFileChannel*]} |
---|
| 193 | catch {file exists testOpenFileChannel1%.fil} err1 |
---|
| 194 | catch {file exists testOpenFileChannel2%.fil} err2 |
---|
| 195 | catch {file exists testOpenFileChannel3%.fil} err3 |
---|
| 196 | catch {file exists __testOpenFileChannel1%__.fil} err4 |
---|
| 197 | catch {file exists __testOpenFileChannel2%__.fil} err5 |
---|
| 198 | catch {file exists __testOpenFileChannel3%__.fil} err6 |
---|
| 199 | list $err1 $err2 $err3 $err4 $err5 $err6 |
---|
| 200 | } {0 0 0 0 0 0} |
---|
| 201 | |
---|
| 202 | test ioUtil-3.2 {TclOpenFileChannelInsertProc: Insert the 3 test TclOpenFileChannel_ procedures.} {testopenfilechannelproc} { |
---|
| 203 | catch {testopenfilechannelproc insert TclpOpenFileChannel} err1 |
---|
| 204 | testopenfilechannelproc insert TestOpenFileChannelProc1 |
---|
| 205 | testopenfilechannelproc insert TestOpenFileChannelProc2 |
---|
| 206 | testopenfilechannelproc insert TestOpenFileChannelProc3 |
---|
| 207 | set err1 |
---|
| 208 | } {bad arg "insert": must be TestOpenFileChannelProc1, TestOpenFileChannelProc2, or TestOpenFileChannelProc3} |
---|
| 209 | |
---|
| 210 | test ioUtil-3.3 {TclOpenFileChannel: Use "file openfilechannel ?" to invoke each procedure.} {testopenfilechannelproc} { |
---|
| 211 | close [open __testOpenFileChannel1%__.fil w] |
---|
| 212 | close [open __testOpenFileChannel2%__.fil w] |
---|
| 213 | close [open __testOpenFileChannel3%__.fil w] |
---|
| 214 | |
---|
| 215 | catch { |
---|
| 216 | close [open testOpenFileChannel1%.fil r] |
---|
| 217 | close [open testOpenFileChannel2%.fil r] |
---|
| 218 | close [open testOpenFileChannel3%.fil r] |
---|
| 219 | } err |
---|
| 220 | |
---|
| 221 | file delete __testOpenFileChannel1%__.fil |
---|
| 222 | file delete __testOpenFileChannel2%__.fil |
---|
| 223 | file delete __testOpenFileChannel3%__.fil |
---|
| 224 | |
---|
| 225 | set err |
---|
| 226 | } {} |
---|
| 227 | |
---|
| 228 | test ioUtil-3.4 {TclOpenFileChannelDeleteProc: "TclpOpenFileChannel" function should not be deletable.} {testopenfilechannelproc} { |
---|
| 229 | catch {testopenfilechannelproc delete TclpOpenFileChannel} err2 |
---|
| 230 | set err2 |
---|
| 231 | } {"TclpOpenFileChannel": could not be deleteed} |
---|
| 232 | |
---|
| 233 | test ioUtil-3.5 {TclOpenFileChannelDeleteProc: Delete the 2nd TclOpenFileChannel procedure.} {testopenfilechannelproc} { |
---|
| 234 | # Delete the 2nd procedure and test that it longer exists but that |
---|
| 235 | # the others do actually return a result. |
---|
| 236 | |
---|
| 237 | testopenfilechannelproc delete TestOpenFileChannelProc2 |
---|
| 238 | |
---|
| 239 | close [open __testOpenFileChannel1%__.fil w] |
---|
| 240 | close [open __testOpenFileChannel3%__.fil w] |
---|
| 241 | |
---|
| 242 | catch { |
---|
| 243 | close [open testOpenFileChannel1%.fil r] |
---|
| 244 | catch {close [open testOpenFileChannel2%.fil r]} msg1 |
---|
| 245 | close [open testOpenFileChannel3%.fil r] |
---|
| 246 | } err3 |
---|
| 247 | |
---|
| 248 | file delete __testOpenFileChannel1%__.fil |
---|
| 249 | file delete __testOpenFileChannel3%__.fil |
---|
| 250 | |
---|
| 251 | list $err3 $msg1 |
---|
| 252 | } {{} {couldn't open "testOpenFileChannel2%.fil": no such file or directory}} |
---|
| 253 | |
---|
| 254 | test ioUtil-3.6 {TclOpenFileChannelDeleteProc: Delete the 1st TclOpenFileChannel procedure.} {testopenfilechannelproc} { |
---|
| 255 | # Next delete the 1st procedure and test that only the 3rd procedure |
---|
| 256 | # is the only one that exists. |
---|
| 257 | |
---|
| 258 | testopenfilechannelproc delete TestOpenFileChannelProc1 |
---|
| 259 | |
---|
| 260 | close [open __testOpenFileChannel3%__.fil w] |
---|
| 261 | |
---|
| 262 | catch { |
---|
| 263 | catch {close [open testOpenFileChannel1%.fil r]} msg2 |
---|
| 264 | catch {close [open testOpenFileChannel2%.fil r]} msg3 |
---|
| 265 | close [open testOpenFileChannel3%.fil r] |
---|
| 266 | } err4 |
---|
| 267 | |
---|
| 268 | file delete __testOpenFileChannel3%__.fil |
---|
| 269 | |
---|
| 270 | list $err4 $msg2 $msg3 |
---|
| 271 | } [list {} \ |
---|
| 272 | {couldn't open "testOpenFileChannel1%.fil": no such file or directory}\ |
---|
| 273 | {couldn't open "testOpenFileChannel2%.fil": no such file or directory}] |
---|
| 274 | |
---|
| 275 | test ioUtil-3.7 {TclOpenFileChannelDeleteProc: Delete the 3rd procedure & verify all are gone.} {testopenfilechannelproc} { |
---|
| 276 | # Finally delete the 3rd procedure and check that none of the |
---|
| 277 | # procedures exist. |
---|
| 278 | |
---|
| 279 | testopenfilechannelproc delete TestOpenFileChannelProc3 |
---|
| 280 | catch { |
---|
| 281 | catch {close [open testOpenFileChannel1%.fil r]} msg4 |
---|
| 282 | catch {close [open testOpenFileChannel2%.fil r]} msg5 |
---|
| 283 | catch {close [open testOpenFileChannel3%.fil r]} msg6 |
---|
| 284 | } err5 |
---|
| 285 | |
---|
| 286 | list $err5 $msg4 $msg5 $msg6 |
---|
| 287 | } [list 1 \ |
---|
| 288 | {couldn't open "testOpenFileChannel1%.fil": no such file or directory}\ |
---|
| 289 | {couldn't open "testOpenFileChannel2%.fil": no such file or directory}\ |
---|
| 290 | {couldn't open "testOpenFileChannel3%.fil": no such file or directory}] |
---|
| 291 | |
---|
| 292 | test ioUtil-3.8 {TclOpenFileChannelDeleteProc: Verify that all procs have been deleted.} {testopenfilechannelproc} { |
---|
| 293 | |
---|
| 294 | # Attempt to delete all the OpenFileChannel procs. again to ensure they no |
---|
| 295 | # longer exist and an error is returned. |
---|
| 296 | |
---|
| 297 | catch {testopenfilechannelproc delete TestOpenFileChannelProc1} err9 |
---|
| 298 | catch {testopenfilechannelproc delete TestOpenFileChannelProc2} err10 |
---|
| 299 | catch {testopenfilechannelproc delete TestOpenFileChannelProc3} err11 |
---|
| 300 | |
---|
| 301 | list $err9 $err10 $err11 |
---|
| 302 | } {{"TestOpenFileChannelProc1": could not be deleteed} {"TestOpenFileChannelProc2": could not be deleteed} {"TestOpenFileChannelProc3": could not be deleteed}} |
---|
| 303 | |
---|
| 304 | test ioUtil-4.1 {open ... a+ must not use O_APPEND: Bug 1773127} -setup { |
---|
| 305 | set f [tcltest::makeFile {} ioutil41.tmp] |
---|
| 306 | set fid [open $f wb] |
---|
| 307 | puts -nonewline $fid 123 |
---|
| 308 | close $fid |
---|
| 309 | } -body { |
---|
| 310 | set fid [open $f ab+] |
---|
| 311 | puts -nonewline $fid 456 |
---|
| 312 | seek $fid 2 |
---|
| 313 | set d [read $fid 2] |
---|
| 314 | seek $fid 4 |
---|
| 315 | puts -nonewline $fid x |
---|
| 316 | close $fid |
---|
| 317 | set fid [open $f rb] |
---|
| 318 | append d [read $fid] |
---|
| 319 | close $fid |
---|
| 320 | return $d |
---|
| 321 | } -cleanup { |
---|
| 322 | tcltest::removeFile $f |
---|
| 323 | } -result 341234x6 |
---|
| 324 | |
---|
| 325 | cd $oldpwd |
---|
| 326 | |
---|
| 327 | # cleanup |
---|
| 328 | ::tcltest::cleanupTests |
---|
| 329 | return |
---|
| 330 | |
---|
| 331 | # Local Variables: |
---|
| 332 | # mode: tcl |
---|
| 333 | # End: |
---|