os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/ioUtil.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/ioUtil.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,310 @@
1.4 +# This file (ioUtil.test) tests the hookable TclStat(), TclAccess(),
1.5 +# and Tcl_OpenFileChannel, routines in the file generic/tclIOUtils.c.
1.6 +# Sourcing this file into Tcl runs the tests and generates output for
1.7 +# errors. No output means no errors were found.
1.8 +#
1.9 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.10 +#
1.11 +# See the file "license.terms" for information on usage and redistribution
1.12 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.13 +#
1.14 +# RCS: @(#) $Id: ioUtil.test,v 1.13.2.1 2003/04/14 15:45:57 vincentdarley Exp $
1.15 +
1.16 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.17 + package require tcltest 2
1.18 + namespace import -force ::tcltest::*
1.19 +}
1.20 +
1.21 +::tcltest::testConstraint testopenfilechannelproc \
1.22 + [llength [info commands testopenfilechannelproc]]
1.23 +::tcltest::testConstraint testaccessproc \
1.24 + [llength [info commands testaccessproc]]
1.25 +::tcltest::testConstraint teststatproc \
1.26 + [llength [info commands teststatproc]]
1.27 +
1.28 +set unsetScript {
1.29 + catch {unset testStat1(size)}
1.30 + catch {unset testStat2(size)}
1.31 + catch {unset testStat3(size)}
1.32 +}
1.33 +
1.34 +test ioUtil-1.1 {TclStat: Check that none of the test procs are there.} {} {
1.35 + catch {file stat testStat1%.fil testStat1} err1
1.36 + catch {file stat testStat2%.fil testStat2} err2
1.37 + catch {file stat testStat3%.fil testStat3} err3
1.38 + list $err1 $err2 $err3
1.39 +} {{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}}
1.40 +
1.41 +test ioUtil-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} {teststatproc} {
1.42 + catch {teststatproc insert TclpStat} err1
1.43 + teststatproc insert TestStatProc1
1.44 + teststatproc insert TestStatProc2
1.45 + teststatproc insert TestStatProc3
1.46 + set err1
1.47 +} {bad arg "insert": must be TestStatProc1, TestStatProc2, or TestStatProc3}
1.48 +
1.49 +test ioUtil-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} {teststatproc} {
1.50 + file stat testStat2%.fil testStat2
1.51 + file stat testStat1%.fil testStat1
1.52 + file stat testStat3%.fil testStat3
1.53 +
1.54 + list $testStat2(size) $testStat1(size) $testStat3(size)
1.55 +} {2345 1234 3456}
1.56 +
1.57 +eval $unsetScript
1.58 +
1.59 +test ioUtil-1.4 {TclStatDeleteProc: "TclpStat" function should not be deletable.} {teststatproc} {
1.60 + catch {teststatproc delete TclpStat} err2
1.61 + set err2
1.62 +} {"TclpStat": could not be deleteed}
1.63 +
1.64 +test ioUtil-1.5 {TclStatDeleteProc: Delete the 2nd TclStat procedure.} {teststatproc} {
1.65 + # Delete the 2nd procedure and test that it longer exists but that
1.66 + # the others do actually return a result.
1.67 +
1.68 + teststatproc delete TestStatProc2
1.69 + file stat testStat1%.fil testStat1
1.70 + catch {file stat testStat2%.fil testStat2} err3
1.71 + file stat testStat3%.fil testStat3
1.72 +
1.73 + list $testStat1(size) $err3 $testStat3(size)
1.74 +} {1234 {could not read "testStat2%.fil": no such file or directory} 3456}
1.75 +
1.76 +eval $unsetScript
1.77 +
1.78 +test ioUtil-1.6 {TclStatDeleteProc: Delete the 1st TclStat procedure.} {teststatproc} {
1.79 + # Next delete the 1st procedure and test that only the 3rd procedure
1.80 + # is the only one that exists.
1.81 +
1.82 + teststatproc delete TestStatProc1
1.83 + catch {file stat testStat1%.fil testStat1} err4
1.84 + catch {file stat testStat2%.fil testStat2} err5
1.85 + file stat testStat3%.fil testStat3
1.86 +
1.87 + list $err4 $err5 $testStat3(size)
1.88 +} {{could not read "testStat1%.fil": no such file or directory} {could not read "testStat2%.fil": no such file or directory} 3456}
1.89 +
1.90 +eval $unsetScript
1.91 +
1.92 +test ioUtil-1.7 {TclStatDeleteProc: Delete the 3rd procedure & verify all are gone.} {teststatproc} {
1.93 + # Finally delete the 3rd procedure and check that none of the
1.94 + # procedures exist.
1.95 +
1.96 + teststatproc delete TestStatProc3
1.97 + catch {file stat testStat1%.fil testStat1} err6
1.98 + catch {file stat testStat2%.fil testStat2} err7
1.99 + catch {file stat testStat3%.fil testStat3} err8
1.100 +
1.101 + list $err6 $err7 $err8
1.102 +} {{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}}
1.103 +
1.104 +eval $unsetScript
1.105 +
1.106 +test ioUtil-1.8 {TclStatDeleteProc: Verify that all procs have been deleted.} {teststatproc} {
1.107 + # Attempt to delete all the Stat procs. again to ensure they no longer
1.108 + # exist and an error is returned.
1.109 +
1.110 + catch {teststatproc delete TestStatProc1} err9
1.111 + catch {teststatproc delete TestStatProc2} err10
1.112 + catch {teststatproc delete TestStatProc3} err11
1.113 +
1.114 + list $err9 $err10 $err11
1.115 +} {{"TestStatProc1": could not be deleteed} {"TestStatProc2": could not be deleteed} {"TestStatProc3": could not be deleteed}}
1.116 +
1.117 +eval $unsetScript
1.118 +
1.119 +test ioUtil-1.9 {TclAccess: Check that none of the test procs are there.} {
1.120 + catch {file exists testAccess1%.fil} err1
1.121 + catch {file exists testAccess2%.fil} err2
1.122 + catch {file exists testAccess3%.fil} err3
1.123 + list $err1 $err2 $err3
1.124 +} {0 0 0}
1.125 +
1.126 +test ioUtil-1.10 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.} {testaccessproc} {
1.127 + catch {testaccessproc insert TclpAccess} err1
1.128 + testaccessproc insert TestAccessProc1
1.129 + testaccessproc insert TestAccessProc2
1.130 + testaccessproc insert TestAccessProc3
1.131 + set err1
1.132 +} {bad arg "insert": must be TestAccessProc1, TestAccessProc2, or TestAccessProc3}
1.133 +
1.134 +test ioUtil-2.3 {TclAccess: Use "file access ?" to invoke each procedure.} {testaccessproc} {
1.135 + list [file exists testAccess2%.fil] \
1.136 + [file exists testAccess1%.fil] \
1.137 + [file exists testAccess3%.fil]
1.138 +} {1 1 1}
1.139 +
1.140 +test ioUtil-2.4 {TclAccessDeleteProc: "TclpAccess" function should not be deletable.} {testaccessproc} {
1.141 + catch {testaccessproc delete TclpAccess} err2
1.142 + set err2
1.143 +} {"TclpAccess": could not be deleteed}
1.144 +
1.145 +test ioUtil-2.5 {TclAccessDeleteProc: Delete the 2nd TclAccess procedure.} {testaccessproc} {
1.146 + # Delete the 2nd procedure and test that it longer exists but that
1.147 + # the others do actually return a result.
1.148 +
1.149 + testaccessproc delete TestAccessProc2
1.150 + set res1 [file exists testAccess1%.fil]
1.151 + catch {file exists testAccess2%.fil} err3
1.152 + set res2 [file exists testAccess3%.fil]
1.153 +
1.154 + list $res1 $err3 $res2
1.155 +} {1 0 1}
1.156 +
1.157 +test ioUtil-2.6 {TclAccessDeleteProc: Delete the 1st TclAccess procedure.} {testaccessproc} {
1.158 + # Next delete the 1st procedure and test that only the 3rd procedure
1.159 + # is the only one that exists.
1.160 +
1.161 + testaccessproc delete TestAccessProc1
1.162 + catch {file exists testAccess1%.fil} err4
1.163 + catch {file exists testAccess2%.fil} err5
1.164 + set res3 [file exists testAccess3%.fil]
1.165 +
1.166 + list $err4 $err5 $res3
1.167 +} {0 0 1}
1.168 +
1.169 +test ioUtil-2.7 {TclAccessDeleteProc: Delete the 3rd procedure & verify all are gone.} {testaccessproc} {
1.170 + # Finally delete the 3rd procedure and check that none of the
1.171 + # procedures exist.
1.172 +
1.173 + testaccessproc delete TestAccessProc3
1.174 + catch {file exists testAccess1%.fil} err6
1.175 + catch {file exists testAccess2%.fil} err7
1.176 + catch {file exists testAccess3%.fil} err8
1.177 +
1.178 + list $err6 $err7 $err8
1.179 +} {0 0 0}
1.180 +
1.181 +test ioUtil-2.8 {TclAccessDeleteProc: Verify that all procs have been deleted.} {testaccessproc} {
1.182 + # Attempt to delete all the Access procs. again to ensure they no longer
1.183 + # exist and an error is returned.
1.184 +
1.185 + catch {testaccessproc delete TestAccessProc1} err9
1.186 + catch {testaccessproc delete TestAccessProc2} err10
1.187 + catch {testaccessproc delete TestAccessProc3} err11
1.188 +
1.189 + list $err9 $err10 $err11
1.190 +} {{"TestAccessProc1": could not be deleteed} {"TestAccessProc2": could not be deleteed} {"TestAccessProc3": could not be deleteed}}
1.191 +
1.192 +# Some of the following tests require a writable current directory
1.193 +set oldpwd [pwd]
1.194 +cd [temporaryDirectory]
1.195 +
1.196 +test ioUtil-3.1 {TclOpenFileChannel: Check that none of the test procs are there.} {testopenfilechannelproc} {
1.197 + catch {eval [list file delete -force] [glob *testOpenFileChannel*]}
1.198 + catch {file exists testOpenFileChannel1%.fil} err1
1.199 + catch {file exists testOpenFileChannel2%.fil} err2
1.200 + catch {file exists testOpenFileChannel3%.fil} err3
1.201 + catch {file exists __testOpenFileChannel1%__.fil} err4
1.202 + catch {file exists __testOpenFileChannel2%__.fil} err5
1.203 + catch {file exists __testOpenFileChannel3%__.fil} err6
1.204 + list $err1 $err2 $err3 $err4 $err5 $err6
1.205 +} {0 0 0 0 0 0}
1.206 +
1.207 +test ioUtil-3.2 {TclOpenFileChannelInsertProc: Insert the 3 test TclOpenFileChannel_ procedures.} {testopenfilechannelproc} {
1.208 + catch {testopenfilechannelproc insert TclpOpenFileChannel} err1
1.209 + testopenfilechannelproc insert TestOpenFileChannelProc1
1.210 + testopenfilechannelproc insert TestOpenFileChannelProc2
1.211 + testopenfilechannelproc insert TestOpenFileChannelProc3
1.212 + set err1
1.213 +} {bad arg "insert": must be TestOpenFileChannelProc1, TestOpenFileChannelProc2, or TestOpenFileChannelProc3}
1.214 +
1.215 +test ioUtil-3.3 {TclOpenFileChannel: Use "file openfilechannel ?" to invoke each procedure.} {testopenfilechannelproc} {
1.216 + close [open __testOpenFileChannel1%__.fil w]
1.217 + close [open __testOpenFileChannel2%__.fil w]
1.218 + close [open __testOpenFileChannel3%__.fil w]
1.219 +
1.220 + catch {
1.221 + close [open testOpenFileChannel1%.fil r]
1.222 + close [open testOpenFileChannel2%.fil r]
1.223 + close [open testOpenFileChannel3%.fil r]
1.224 + } err
1.225 +
1.226 + file delete __testOpenFileChannel1%__.fil
1.227 + file delete __testOpenFileChannel2%__.fil
1.228 + file delete __testOpenFileChannel3%__.fil
1.229 +
1.230 + set err
1.231 +} {}
1.232 +
1.233 +test ioUtil-3.4 {TclOpenFileChannelDeleteProc: "TclpOpenFileChannel" function should not be deletable.} {testopenfilechannelproc} {
1.234 + catch {testopenfilechannelproc delete TclpOpenFileChannel} err2
1.235 + set err2
1.236 +} {"TclpOpenFileChannel": could not be deleteed}
1.237 +
1.238 +test ioUtil-3.5 {TclOpenFileChannelDeleteProc: Delete the 2nd TclOpenFileChannel procedure.} {testopenfilechannelproc} {
1.239 + # Delete the 2nd procedure and test that it longer exists but that
1.240 + # the others do actually return a result.
1.241 +
1.242 + testopenfilechannelproc delete TestOpenFileChannelProc2
1.243 +
1.244 + close [open __testOpenFileChannel1%__.fil w]
1.245 + close [open __testOpenFileChannel3%__.fil w]
1.246 +
1.247 + catch {
1.248 + close [open testOpenFileChannel1%.fil r]
1.249 + catch {close [open testOpenFileChannel2%.fil r]} msg1
1.250 + close [open testOpenFileChannel3%.fil r]
1.251 + } err3
1.252 +
1.253 + file delete __testOpenFileChannel1%__.fil
1.254 + file delete __testOpenFileChannel3%__.fil
1.255 +
1.256 + list $err3 $msg1
1.257 +} {{} {couldn't open "testOpenFileChannel2%.fil": no such file or directory}}
1.258 +
1.259 +test ioUtil-3.6 {TclOpenFileChannelDeleteProc: Delete the 1st TclOpenFileChannel procedure.} {testopenfilechannelproc} {
1.260 + # Next delete the 1st procedure and test that only the 3rd procedure
1.261 + # is the only one that exists.
1.262 +
1.263 + testopenfilechannelproc delete TestOpenFileChannelProc1
1.264 +
1.265 + close [open __testOpenFileChannel3%__.fil w]
1.266 +
1.267 + catch {
1.268 + catch {close [open testOpenFileChannel1%.fil r]} msg2
1.269 + catch {close [open testOpenFileChannel2%.fil r]} msg3
1.270 + close [open testOpenFileChannel3%.fil r]
1.271 + } err4
1.272 +
1.273 + file delete __testOpenFileChannel3%__.fil
1.274 +
1.275 + list $err4 $msg2 $msg3
1.276 +} [list {} \
1.277 + {couldn't open "testOpenFileChannel1%.fil": no such file or directory}\
1.278 + {couldn't open "testOpenFileChannel2%.fil": no such file or directory}]
1.279 +
1.280 +test ioUtil-3.7 {TclOpenFileChannelDeleteProc: Delete the 3rd procedure & verify all are gone.} {testopenfilechannelproc} {
1.281 + # Finally delete the 3rd procedure and check that none of the
1.282 + # procedures exist.
1.283 +
1.284 + testopenfilechannelproc delete TestOpenFileChannelProc3
1.285 + catch {
1.286 + catch {close [open testOpenFileChannel1%.fil r]} msg4
1.287 + catch {close [open testOpenFileChannel2%.fil r]} msg5
1.288 + catch {close [open testOpenFileChannel3%.fil r]} msg6
1.289 + } err5
1.290 +
1.291 + list $err5 $msg4 $msg5 $msg6
1.292 +} [list 1 \
1.293 + {couldn't open "testOpenFileChannel1%.fil": no such file or directory}\
1.294 + {couldn't open "testOpenFileChannel2%.fil": no such file or directory}\
1.295 + {couldn't open "testOpenFileChannel3%.fil": no such file or directory}]
1.296 +
1.297 +test ioUtil-3.8 {TclOpenFileChannelDeleteProc: Verify that all procs have been deleted.} {testopenfilechannelproc} {
1.298 +
1.299 + # Attempt to delete all the OpenFileChannel procs. again to ensure they no
1.300 + # longer exist and an error is returned.
1.301 +
1.302 + catch {testopenfilechannelproc delete TestOpenFileChannelProc1} err9
1.303 + catch {testopenfilechannelproc delete TestOpenFileChannelProc2} err10
1.304 + catch {testopenfilechannelproc delete TestOpenFileChannelProc3} err11
1.305 +
1.306 + list $err9 $err10 $err11
1.307 +} {{"TestOpenFileChannelProc1": could not be deleteed} {"TestOpenFileChannelProc2": could not be deleteed} {"TestOpenFileChannelProc3": could not be deleteed}}
1.308 +
1.309 +cd $oldpwd
1.310 +
1.311 +# cleanup
1.312 +::tcltest::cleanupTests
1.313 +return