sl@0: # This file (ioUtil.test) tests the hookable TclStat(), TclAccess(), sl@0: # and Tcl_OpenFileChannel, routines in the file generic/tclIOUtils.c. sl@0: # Sourcing this file into Tcl runs the tests and generates output for sl@0: # errors. No output means no errors were found. sl@0: # sl@0: # Copyright (c) 1998-1999 by Scriptics Corporation. sl@0: # sl@0: # See the file "license.terms" for information on usage and redistribution sl@0: # of this file, and for a DISCLAIMER OF ALL WARRANTIES. sl@0: # sl@0: # RCS: @(#) $Id: ioUtil.test,v 1.13.2.1 2003/04/14 15:45:57 vincentdarley Exp $ sl@0: sl@0: if {[lsearch [namespace children] ::tcltest] == -1} { sl@0: package require tcltest 2 sl@0: namespace import -force ::tcltest::* sl@0: } sl@0: sl@0: ::tcltest::testConstraint testopenfilechannelproc \ sl@0: [llength [info commands testopenfilechannelproc]] sl@0: ::tcltest::testConstraint testaccessproc \ sl@0: [llength [info commands testaccessproc]] sl@0: ::tcltest::testConstraint teststatproc \ sl@0: [llength [info commands teststatproc]] sl@0: sl@0: set unsetScript { sl@0: catch {unset testStat1(size)} sl@0: catch {unset testStat2(size)} sl@0: catch {unset testStat3(size)} sl@0: } sl@0: sl@0: test ioUtil-1.1 {TclStat: Check that none of the test procs are there.} {} { sl@0: catch {file stat testStat1%.fil testStat1} err1 sl@0: catch {file stat testStat2%.fil testStat2} err2 sl@0: catch {file stat testStat3%.fil testStat3} err3 sl@0: list $err1 $err2 $err3 sl@0: } {{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}} sl@0: sl@0: test ioUtil-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} {teststatproc} { sl@0: catch {teststatproc insert TclpStat} err1 sl@0: teststatproc insert TestStatProc1 sl@0: teststatproc insert TestStatProc2 sl@0: teststatproc insert TestStatProc3 sl@0: set err1 sl@0: } {bad arg "insert": must be TestStatProc1, TestStatProc2, or TestStatProc3} sl@0: sl@0: test ioUtil-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} {teststatproc} { sl@0: file stat testStat2%.fil testStat2 sl@0: file stat testStat1%.fil testStat1 sl@0: file stat testStat3%.fil testStat3 sl@0: sl@0: list $testStat2(size) $testStat1(size) $testStat3(size) sl@0: } {2345 1234 3456} sl@0: sl@0: eval $unsetScript sl@0: sl@0: test ioUtil-1.4 {TclStatDeleteProc: "TclpStat" function should not be deletable.} {teststatproc} { sl@0: catch {teststatproc delete TclpStat} err2 sl@0: set err2 sl@0: } {"TclpStat": could not be deleteed} sl@0: sl@0: test ioUtil-1.5 {TclStatDeleteProc: Delete the 2nd TclStat procedure.} {teststatproc} { sl@0: # Delete the 2nd procedure and test that it longer exists but that sl@0: # the others do actually return a result. sl@0: sl@0: teststatproc delete TestStatProc2 sl@0: file stat testStat1%.fil testStat1 sl@0: catch {file stat testStat2%.fil testStat2} err3 sl@0: file stat testStat3%.fil testStat3 sl@0: sl@0: list $testStat1(size) $err3 $testStat3(size) sl@0: } {1234 {could not read "testStat2%.fil": no such file or directory} 3456} sl@0: sl@0: eval $unsetScript sl@0: sl@0: test ioUtil-1.6 {TclStatDeleteProc: Delete the 1st TclStat procedure.} {teststatproc} { sl@0: # Next delete the 1st procedure and test that only the 3rd procedure sl@0: # is the only one that exists. sl@0: sl@0: teststatproc delete TestStatProc1 sl@0: catch {file stat testStat1%.fil testStat1} err4 sl@0: catch {file stat testStat2%.fil testStat2} err5 sl@0: file stat testStat3%.fil testStat3 sl@0: sl@0: list $err4 $err5 $testStat3(size) sl@0: } {{could not read "testStat1%.fil": no such file or directory} {could not read "testStat2%.fil": no such file or directory} 3456} sl@0: sl@0: eval $unsetScript sl@0: sl@0: test ioUtil-1.7 {TclStatDeleteProc: Delete the 3rd procedure & verify all are gone.} {teststatproc} { sl@0: # Finally delete the 3rd procedure and check that none of the sl@0: # procedures exist. sl@0: sl@0: teststatproc delete TestStatProc3 sl@0: catch {file stat testStat1%.fil testStat1} err6 sl@0: catch {file stat testStat2%.fil testStat2} err7 sl@0: catch {file stat testStat3%.fil testStat3} err8 sl@0: sl@0: list $err6 $err7 $err8 sl@0: } {{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}} sl@0: sl@0: eval $unsetScript sl@0: sl@0: test ioUtil-1.8 {TclStatDeleteProc: Verify that all procs have been deleted.} {teststatproc} { sl@0: # Attempt to delete all the Stat procs. again to ensure they no longer sl@0: # exist and an error is returned. sl@0: sl@0: catch {teststatproc delete TestStatProc1} err9 sl@0: catch {teststatproc delete TestStatProc2} err10 sl@0: catch {teststatproc delete TestStatProc3} err11 sl@0: sl@0: list $err9 $err10 $err11 sl@0: } {{"TestStatProc1": could not be deleteed} {"TestStatProc2": could not be deleteed} {"TestStatProc3": could not be deleteed}} sl@0: sl@0: eval $unsetScript sl@0: sl@0: test ioUtil-1.9 {TclAccess: Check that none of the test procs are there.} { sl@0: catch {file exists testAccess1%.fil} err1 sl@0: catch {file exists testAccess2%.fil} err2 sl@0: catch {file exists testAccess3%.fil} err3 sl@0: list $err1 $err2 $err3 sl@0: } {0 0 0} sl@0: sl@0: test ioUtil-1.10 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.} {testaccessproc} { sl@0: catch {testaccessproc insert TclpAccess} err1 sl@0: testaccessproc insert TestAccessProc1 sl@0: testaccessproc insert TestAccessProc2 sl@0: testaccessproc insert TestAccessProc3 sl@0: set err1 sl@0: } {bad arg "insert": must be TestAccessProc1, TestAccessProc2, or TestAccessProc3} sl@0: sl@0: test ioUtil-2.3 {TclAccess: Use "file access ?" to invoke each procedure.} {testaccessproc} { sl@0: list [file exists testAccess2%.fil] \ sl@0: [file exists testAccess1%.fil] \ sl@0: [file exists testAccess3%.fil] sl@0: } {1 1 1} sl@0: sl@0: test ioUtil-2.4 {TclAccessDeleteProc: "TclpAccess" function should not be deletable.} {testaccessproc} { sl@0: catch {testaccessproc delete TclpAccess} err2 sl@0: set err2 sl@0: } {"TclpAccess": could not be deleteed} sl@0: sl@0: test ioUtil-2.5 {TclAccessDeleteProc: Delete the 2nd TclAccess procedure.} {testaccessproc} { sl@0: # Delete the 2nd procedure and test that it longer exists but that sl@0: # the others do actually return a result. sl@0: sl@0: testaccessproc delete TestAccessProc2 sl@0: set res1 [file exists testAccess1%.fil] sl@0: catch {file exists testAccess2%.fil} err3 sl@0: set res2 [file exists testAccess3%.fil] sl@0: sl@0: list $res1 $err3 $res2 sl@0: } {1 0 1} sl@0: sl@0: test ioUtil-2.6 {TclAccessDeleteProc: Delete the 1st TclAccess procedure.} {testaccessproc} { sl@0: # Next delete the 1st procedure and test that only the 3rd procedure sl@0: # is the only one that exists. sl@0: sl@0: testaccessproc delete TestAccessProc1 sl@0: catch {file exists testAccess1%.fil} err4 sl@0: catch {file exists testAccess2%.fil} err5 sl@0: set res3 [file exists testAccess3%.fil] sl@0: sl@0: list $err4 $err5 $res3 sl@0: } {0 0 1} sl@0: sl@0: test ioUtil-2.7 {TclAccessDeleteProc: Delete the 3rd procedure & verify all are gone.} {testaccessproc} { sl@0: # Finally delete the 3rd procedure and check that none of the sl@0: # procedures exist. sl@0: sl@0: testaccessproc delete TestAccessProc3 sl@0: catch {file exists testAccess1%.fil} err6 sl@0: catch {file exists testAccess2%.fil} err7 sl@0: catch {file exists testAccess3%.fil} err8 sl@0: sl@0: list $err6 $err7 $err8 sl@0: } {0 0 0} sl@0: sl@0: test ioUtil-2.8 {TclAccessDeleteProc: Verify that all procs have been deleted.} {testaccessproc} { sl@0: # Attempt to delete all the Access procs. again to ensure they no longer sl@0: # exist and an error is returned. sl@0: sl@0: catch {testaccessproc delete TestAccessProc1} err9 sl@0: catch {testaccessproc delete TestAccessProc2} err10 sl@0: catch {testaccessproc delete TestAccessProc3} err11 sl@0: sl@0: list $err9 $err10 $err11 sl@0: } {{"TestAccessProc1": could not be deleteed} {"TestAccessProc2": could not be deleteed} {"TestAccessProc3": could not be deleteed}} sl@0: sl@0: # Some of the following tests require a writable current directory sl@0: set oldpwd [pwd] sl@0: cd [temporaryDirectory] sl@0: sl@0: test ioUtil-3.1 {TclOpenFileChannel: Check that none of the test procs are there.} {testopenfilechannelproc} { sl@0: catch {eval [list file delete -force] [glob *testOpenFileChannel*]} sl@0: catch {file exists testOpenFileChannel1%.fil} err1 sl@0: catch {file exists testOpenFileChannel2%.fil} err2 sl@0: catch {file exists testOpenFileChannel3%.fil} err3 sl@0: catch {file exists __testOpenFileChannel1%__.fil} err4 sl@0: catch {file exists __testOpenFileChannel2%__.fil} err5 sl@0: catch {file exists __testOpenFileChannel3%__.fil} err6 sl@0: list $err1 $err2 $err3 $err4 $err5 $err6 sl@0: } {0 0 0 0 0 0} sl@0: sl@0: test ioUtil-3.2 {TclOpenFileChannelInsertProc: Insert the 3 test TclOpenFileChannel_ procedures.} {testopenfilechannelproc} { sl@0: catch {testopenfilechannelproc insert TclpOpenFileChannel} err1 sl@0: testopenfilechannelproc insert TestOpenFileChannelProc1 sl@0: testopenfilechannelproc insert TestOpenFileChannelProc2 sl@0: testopenfilechannelproc insert TestOpenFileChannelProc3 sl@0: set err1 sl@0: } {bad arg "insert": must be TestOpenFileChannelProc1, TestOpenFileChannelProc2, or TestOpenFileChannelProc3} sl@0: sl@0: test ioUtil-3.3 {TclOpenFileChannel: Use "file openfilechannel ?" to invoke each procedure.} {testopenfilechannelproc} { sl@0: close [open __testOpenFileChannel1%__.fil w] sl@0: close [open __testOpenFileChannel2%__.fil w] sl@0: close [open __testOpenFileChannel3%__.fil w] sl@0: sl@0: catch { sl@0: close [open testOpenFileChannel1%.fil r] sl@0: close [open testOpenFileChannel2%.fil r] sl@0: close [open testOpenFileChannel3%.fil r] sl@0: } err sl@0: sl@0: file delete __testOpenFileChannel1%__.fil sl@0: file delete __testOpenFileChannel2%__.fil sl@0: file delete __testOpenFileChannel3%__.fil sl@0: sl@0: set err sl@0: } {} sl@0: sl@0: test ioUtil-3.4 {TclOpenFileChannelDeleteProc: "TclpOpenFileChannel" function should not be deletable.} {testopenfilechannelproc} { sl@0: catch {testopenfilechannelproc delete TclpOpenFileChannel} err2 sl@0: set err2 sl@0: } {"TclpOpenFileChannel": could not be deleteed} sl@0: sl@0: test ioUtil-3.5 {TclOpenFileChannelDeleteProc: Delete the 2nd TclOpenFileChannel procedure.} {testopenfilechannelproc} { sl@0: # Delete the 2nd procedure and test that it longer exists but that sl@0: # the others do actually return a result. sl@0: sl@0: testopenfilechannelproc delete TestOpenFileChannelProc2 sl@0: sl@0: close [open __testOpenFileChannel1%__.fil w] sl@0: close [open __testOpenFileChannel3%__.fil w] sl@0: sl@0: catch { sl@0: close [open testOpenFileChannel1%.fil r] sl@0: catch {close [open testOpenFileChannel2%.fil r]} msg1 sl@0: close [open testOpenFileChannel3%.fil r] sl@0: } err3 sl@0: sl@0: file delete __testOpenFileChannel1%__.fil sl@0: file delete __testOpenFileChannel3%__.fil sl@0: sl@0: list $err3 $msg1 sl@0: } {{} {couldn't open "testOpenFileChannel2%.fil": no such file or directory}} sl@0: sl@0: test ioUtil-3.6 {TclOpenFileChannelDeleteProc: Delete the 1st TclOpenFileChannel procedure.} {testopenfilechannelproc} { sl@0: # Next delete the 1st procedure and test that only the 3rd procedure sl@0: # is the only one that exists. sl@0: sl@0: testopenfilechannelproc delete TestOpenFileChannelProc1 sl@0: sl@0: close [open __testOpenFileChannel3%__.fil w] sl@0: sl@0: catch { sl@0: catch {close [open testOpenFileChannel1%.fil r]} msg2 sl@0: catch {close [open testOpenFileChannel2%.fil r]} msg3 sl@0: close [open testOpenFileChannel3%.fil r] sl@0: } err4 sl@0: sl@0: file delete __testOpenFileChannel3%__.fil sl@0: sl@0: list $err4 $msg2 $msg3 sl@0: } [list {} \ sl@0: {couldn't open "testOpenFileChannel1%.fil": no such file or directory}\ sl@0: {couldn't open "testOpenFileChannel2%.fil": no such file or directory}] sl@0: sl@0: test ioUtil-3.7 {TclOpenFileChannelDeleteProc: Delete the 3rd procedure & verify all are gone.} {testopenfilechannelproc} { sl@0: # Finally delete the 3rd procedure and check that none of the sl@0: # procedures exist. sl@0: sl@0: testopenfilechannelproc delete TestOpenFileChannelProc3 sl@0: catch { sl@0: catch {close [open testOpenFileChannel1%.fil r]} msg4 sl@0: catch {close [open testOpenFileChannel2%.fil r]} msg5 sl@0: catch {close [open testOpenFileChannel3%.fil r]} msg6 sl@0: } err5 sl@0: sl@0: list $err5 $msg4 $msg5 $msg6 sl@0: } [list 1 \ sl@0: {couldn't open "testOpenFileChannel1%.fil": no such file or directory}\ sl@0: {couldn't open "testOpenFileChannel2%.fil": no such file or directory}\ sl@0: {couldn't open "testOpenFileChannel3%.fil": no such file or directory}] sl@0: sl@0: test ioUtil-3.8 {TclOpenFileChannelDeleteProc: Verify that all procs have been deleted.} {testopenfilechannelproc} { sl@0: sl@0: # Attempt to delete all the OpenFileChannel procs. again to ensure they no sl@0: # longer exist and an error is returned. sl@0: sl@0: catch {testopenfilechannelproc delete TestOpenFileChannelProc1} err9 sl@0: catch {testopenfilechannelproc delete TestOpenFileChannelProc2} err10 sl@0: catch {testopenfilechannelproc delete TestOpenFileChannelProc3} err11 sl@0: sl@0: list $err9 $err10 $err11 sl@0: } {{"TestOpenFileChannelProc1": could not be deleteed} {"TestOpenFileChannelProc2": could not be deleteed} {"TestOpenFileChannelProc3": could not be deleteed}} sl@0: sl@0: cd $oldpwd sl@0: sl@0: # cleanup sl@0: ::tcltest::cleanupTests sl@0: return