diff options
Diffstat (limited to 'tests/ioUtil.test')
| -rw-r--r-- | tests/ioUtil.test | 333 |
1 files changed, 333 insertions, 0 deletions
diff --git a/tests/ioUtil.test b/tests/ioUtil.test new file mode 100644 index 0000000..0f0d2fc --- /dev/null +++ b/tests/ioUtil.test @@ -0,0 +1,333 @@ +# 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-1999 by Scriptics Corporation. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: ioUtil.test,v 1.19 2007/12/13 15:26:06 dgp Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest 2 + namespace import -force ::tcltest::* +} + +testConstraint testopenfilechannelproc \ + [llength [info commands testopenfilechannelproc]] +testConstraint testaccessproc [llength [info commands testaccessproc]] +testConstraint teststatproc [llength [info commands teststatproc]] + +set unsetScript { + catch {unset testStat1(size)} + catch {unset testStat2(size)} + catch {unset testStat3(size)} +} + +test ioUtil-1.1 {TclStat: Check that none of the test procs are there.} {} { + catch {file stat testStat1%.fil testStat1} err1 + catch {file stat testStat2%.fil testStat2} err2 + catch {file stat testStat3%.fil testStat3} err3 + list $err1 $err2 $err3 +} {{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}} + +test ioUtil-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} {teststatproc} { + catch {teststatproc insert TclpStat} err1 + teststatproc insert TestStatProc1 + teststatproc insert TestStatProc2 + teststatproc insert TestStatProc3 + set err1 +} {bad arg "insert": must be TestStatProc1, TestStatProc2, or TestStatProc3} + +test ioUtil-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} {teststatproc} { + file stat testStat2%.fil testStat2 + file stat testStat1%.fil testStat1 + file stat testStat3%.fil testStat3 + + list $testStat2(size) $testStat1(size) $testStat3(size) +} {2345 1234 3456} + +eval $unsetScript + +test ioUtil-1.4 {TclStatDeleteProc: "TclpStat" function should not be deletable.} {teststatproc} { + catch {teststatproc delete TclpStat} err2 + set err2 +} {"TclpStat": could not be deleteed} + +test ioUtil-1.5 {TclStatDeleteProc: Delete the 2nd TclStat procedure.} {teststatproc} { + # Delete the 2nd procedure and test that it longer exists but that + # the others do actually return a result. + + teststatproc delete TestStatProc2 + file stat testStat1%.fil testStat1 + catch {file stat testStat2%.fil testStat2} err3 + file stat testStat3%.fil testStat3 + + list $testStat1(size) $err3 $testStat3(size) +} {1234 {could not read "testStat2%.fil": no such file or directory} 3456} + +eval $unsetScript + +test ioUtil-1.6 {TclStatDeleteProc: Delete the 1st TclStat procedure.} {teststatproc} { + # Next delete the 1st procedure and test that only the 3rd procedure + # is the only one that exists. + + teststatproc delete TestStatProc1 + catch {file stat testStat1%.fil testStat1} err4 + catch {file stat testStat2%.fil testStat2} err5 + file stat testStat3%.fil testStat3 + + list $err4 $err5 $testStat3(size) +} {{could not read "testStat1%.fil": no such file or directory} {could not read "testStat2%.fil": no such file or directory} 3456} + +eval $unsetScript + +test ioUtil-1.7 {TclStatDeleteProc: Delete the 3rd procedure & verify all are gone.} {teststatproc} { + # Finally delete the 3rd procedure and check that none of the + # procedures exist. + + teststatproc delete TestStatProc3 + catch {file stat testStat1%.fil testStat1} err6 + catch {file stat testStat2%.fil testStat2} err7 + catch {file stat testStat3%.fil testStat3} err8 + + list $err6 $err7 $err8 +} {{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}} + +eval $unsetScript + +test ioUtil-1.8 {TclStatDeleteProc: Verify that all procs have been deleted.} {teststatproc} { + # Attempt to delete all the Stat procs. again to ensure they no longer + # exist and an error is returned. + + catch {teststatproc delete TestStatProc1} err9 + catch {teststatproc delete TestStatProc2} err10 + catch {teststatproc delete TestStatProc3} err11 + + list $err9 $err10 $err11 +} {{"TestStatProc1": could not be deleteed} {"TestStatProc2": could not be deleteed} {"TestStatProc3": could not be deleteed}} + +eval $unsetScript + +test ioUtil-1.9 {TclAccess: Check that none of the test procs are there.} { + catch {file exists testAccess1%.fil} err1 + catch {file exists testAccess2%.fil} err2 + catch {file exists testAccess3%.fil} err3 + list $err1 $err2 $err3 +} {0 0 0} + +test ioUtil-1.10 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.} {testaccessproc} { + catch {testaccessproc insert TclpAccess} err1 + testaccessproc insert TestAccessProc1 + testaccessproc insert TestAccessProc2 + testaccessproc insert TestAccessProc3 + set err1 +} {bad arg "insert": must be TestAccessProc1, TestAccessProc2, or TestAccessProc3} + +test ioUtil-2.3 {TclAccess: Use "file access ?" to invoke each procedure.} {testaccessproc} { + list [file exists testAccess2%.fil] \ + [file exists testAccess1%.fil] \ + [file exists testAccess3%.fil] +} {1 1 1} + +test ioUtil-2.4 {TclAccessDeleteProc: "TclpAccess" function should not be deletable.} {testaccessproc} { + catch {testaccessproc delete TclpAccess} err2 + set err2 +} {"TclpAccess": could not be deleteed} + +test ioUtil-2.5 {TclAccessDeleteProc: Delete the 2nd TclAccess procedure.} {testaccessproc} { + # Delete the 2nd procedure and test that it longer exists but that + # the others do actually return a result. + + testaccessproc delete TestAccessProc2 + set res1 [file exists testAccess1%.fil] + catch {file exists testAccess2%.fil} err3 + set res2 [file exists testAccess3%.fil] + + list $res1 $err3 $res2 +} {1 0 1} + +test ioUtil-2.6 {TclAccessDeleteProc: Delete the 1st TclAccess procedure.} {testaccessproc} { + # Next delete the 1st procedure and test that only the 3rd procedure + # is the only one that exists. + + testaccessproc delete TestAccessProc1 + catch {file exists testAccess1%.fil} err4 + catch {file exists testAccess2%.fil} err5 + set res3 [file exists testAccess3%.fil] + + list $err4 $err5 $res3 +} {0 0 1} + +test ioUtil-2.7 {TclAccessDeleteProc: Delete the 3rd procedure & verify all are gone.} {testaccessproc} { + # Finally delete the 3rd procedure and check that none of the + # procedures exist. + + testaccessproc delete TestAccessProc3 + catch {file exists testAccess1%.fil} err6 + catch {file exists testAccess2%.fil} err7 + catch {file exists testAccess3%.fil} err8 + + list $err6 $err7 $err8 +} {0 0 0} + +test ioUtil-2.8 {TclAccessDeleteProc: Verify that all procs have been deleted.} {testaccessproc} { + # Attempt to delete all the Access procs. again to ensure they no longer + # exist and an error is returned. + + catch {testaccessproc delete TestAccessProc1} err9 + catch {testaccessproc delete TestAccessProc2} err10 + catch {testaccessproc delete TestAccessProc3} err11 + + list $err9 $err10 $err11 +} {{"TestAccessProc1": could not be deleteed} {"TestAccessProc2": could not be deleteed} {"TestAccessProc3": could not be deleteed}} + +# Some of the following tests require a writable current directory +set oldpwd [pwd] +cd [temporaryDirectory] + +test ioUtil-3.1 {TclOpenFileChannel: Check that none of the test procs are there.} {testopenfilechannelproc} { + catch {file delete -force {*}[glob *testOpenFileChannel*]} + catch {file exists testOpenFileChannel1%.fil} err1 + catch {file exists testOpenFileChannel2%.fil} err2 + catch {file exists testOpenFileChannel3%.fil} err3 + catch {file exists __testOpenFileChannel1%__.fil} err4 + catch {file exists __testOpenFileChannel2%__.fil} err5 + catch {file exists __testOpenFileChannel3%__.fil} err6 + list $err1 $err2 $err3 $err4 $err5 $err6 +} {0 0 0 0 0 0} + +test ioUtil-3.2 {TclOpenFileChannelInsertProc: Insert the 3 test TclOpenFileChannel_ procedures.} {testopenfilechannelproc} { + catch {testopenfilechannelproc insert TclpOpenFileChannel} err1 + testopenfilechannelproc insert TestOpenFileChannelProc1 + testopenfilechannelproc insert TestOpenFileChannelProc2 + testopenfilechannelproc insert TestOpenFileChannelProc3 + set err1 +} {bad arg "insert": must be TestOpenFileChannelProc1, TestOpenFileChannelProc2, or TestOpenFileChannelProc3} + +test ioUtil-3.3 {TclOpenFileChannel: Use "file openfilechannel ?" to invoke each procedure.} {testopenfilechannelproc} { + close [open __testOpenFileChannel1%__.fil w] + close [open __testOpenFileChannel2%__.fil w] + close [open __testOpenFileChannel3%__.fil w] + + catch { + close [open testOpenFileChannel1%.fil r] + close [open testOpenFileChannel2%.fil r] + close [open testOpenFileChannel3%.fil r] + } err + + file delete __testOpenFileChannel1%__.fil + file delete __testOpenFileChannel2%__.fil + file delete __testOpenFileChannel3%__.fil + + set err +} {} + +test ioUtil-3.4 {TclOpenFileChannelDeleteProc: "TclpOpenFileChannel" function should not be deletable.} {testopenfilechannelproc} { + catch {testopenfilechannelproc delete TclpOpenFileChannel} err2 + set err2 +} {"TclpOpenFileChannel": could not be deleteed} + +test ioUtil-3.5 {TclOpenFileChannelDeleteProc: Delete the 2nd TclOpenFileChannel procedure.} {testopenfilechannelproc} { + # Delete the 2nd procedure and test that it longer exists but that + # the others do actually return a result. + + testopenfilechannelproc delete TestOpenFileChannelProc2 + + close [open __testOpenFileChannel1%__.fil w] + close [open __testOpenFileChannel3%__.fil w] + + catch { + close [open testOpenFileChannel1%.fil r] + catch {close [open testOpenFileChannel2%.fil r]} msg1 + close [open testOpenFileChannel3%.fil r] + } err3 + + file delete __testOpenFileChannel1%__.fil + file delete __testOpenFileChannel3%__.fil + + list $err3 $msg1 +} {{} {couldn't open "testOpenFileChannel2%.fil": no such file or directory}} + +test ioUtil-3.6 {TclOpenFileChannelDeleteProc: Delete the 1st TclOpenFileChannel procedure.} {testopenfilechannelproc} { + # Next delete the 1st procedure and test that only the 3rd procedure + # is the only one that exists. + + testopenfilechannelproc delete TestOpenFileChannelProc1 + + close [open __testOpenFileChannel3%__.fil w] + + catch { + catch {close [open testOpenFileChannel1%.fil r]} msg2 + catch {close [open testOpenFileChannel2%.fil r]} msg3 + close [open testOpenFileChannel3%.fil r] + } err4 + + file delete __testOpenFileChannel3%__.fil + + list $err4 $msg2 $msg3 +} [list {} \ + {couldn't open "testOpenFileChannel1%.fil": no such file or directory}\ + {couldn't open "testOpenFileChannel2%.fil": no such file or directory}] + +test ioUtil-3.7 {TclOpenFileChannelDeleteProc: Delete the 3rd procedure & verify all are gone.} {testopenfilechannelproc} { + # Finally delete the 3rd procedure and check that none of the + # procedures exist. + + testopenfilechannelproc delete TestOpenFileChannelProc3 + catch { + catch {close [open testOpenFileChannel1%.fil r]} msg4 + catch {close [open testOpenFileChannel2%.fil r]} msg5 + catch {close [open testOpenFileChannel3%.fil r]} msg6 + } err5 + + list $err5 $msg4 $msg5 $msg6 +} [list 1 \ + {couldn't open "testOpenFileChannel1%.fil": no such file or directory}\ + {couldn't open "testOpenFileChannel2%.fil": no such file or directory}\ + {couldn't open "testOpenFileChannel3%.fil": no such file or directory}] + +test ioUtil-3.8 {TclOpenFileChannelDeleteProc: Verify that all procs have been deleted.} {testopenfilechannelproc} { + + # Attempt to delete all the OpenFileChannel procs. again to ensure they no + # longer exist and an error is returned. + + catch {testopenfilechannelproc delete TestOpenFileChannelProc1} err9 + catch {testopenfilechannelproc delete TestOpenFileChannelProc2} err10 + catch {testopenfilechannelproc delete TestOpenFileChannelProc3} err11 + + list $err9 $err10 $err11 +} {{"TestOpenFileChannelProc1": could not be deleteed} {"TestOpenFileChannelProc2": could not be deleteed} {"TestOpenFileChannelProc3": could not be deleteed}} + +test ioUtil-4.1 {open ... a+ must not use O_APPEND: Bug 1773127} -setup { + set f [tcltest::makeFile {} ioutil41.tmp] + set fid [open $f wb] + puts -nonewline $fid 123 + close $fid +} -body { + set fid [open $f ab+] + puts -nonewline $fid 456 + seek $fid 2 + set d [read $fid 2] + seek $fid 4 + puts -nonewline $fid x + close $fid + set fid [open $f rb] + append d [read $fid] + close $fid + return $d +} -cleanup { + tcltest::removeFile $f +} -result 341234x6 + +cd $oldpwd + +# cleanup +::tcltest::cleanupTests +return + +# Local Variables: +# mode: tcl +# End: |