# 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 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.2 2001/09/14 01:43:40 zlaski Exp $ if {[string compare test [info procs test]] == 1} then {source defs} set unsetScript { catch {unset testStat1(size)} catch {unset testStat2(size)} catch {unset testStat3(size)} } test stat-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 } {{couldn't stat "testStat1%.fil": no such file or directory} {couldn't stat "testStat2%.fil": no such file or directory} {couldn't stat "testStat3%.fil": no such file or directory}} if {[info commands teststatproc] == {}} { puts "This application hasn't been compiled with the \"teststatproc\"" puts "command, so I can't test Tcl_Stat_* etc." } else { test stat-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} { 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 stat-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} { 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 stat-1.4 {TclStatDeleteProc: "TclpStat" function should not be deletedable.} { catch {teststatproc delete TclpStat} err2 set err2 } {"TclpStat": could not be deleteed} test stat-1.5 {TclStatDeleteProc: Delete the 2nd TclStat procedure.} { # 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 {couldn't stat "testStat2%.fil": no such file or directory} 3456} eval $unsetScript test stat-1.6 {TclStatDeleteProc: Delete the 1st TclStat procedure.} { # 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) } {{couldn't stat "testStat1%.fil": no such file or directory} {couldn't stat "testStat2%.fil": no such file or directory} 3456} eval $unsetScript test stat-1.7 {TclStatDeleteProc: Delete the 3rd procedure & verify all are gone.} { # 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 } {{couldn't stat "testStat1%.fil": no such file or directory} {couldn't stat "testStat2%.fil": no such file or directory} {couldn't stat "testStat3%.fil": no such file or directory}} eval $unsetScript test stat-1.8 {TclStatDeleteProc: Verify that all procs have been deleted.} { # 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 access-1.1 {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} if {[info commands testaccessproc] == {}} { puts "This application hasn't been compiled with the \"testaccessproc\"" puts "command, so I can't test Tcl_Access_* etc." } else { test access-1.2 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.} { 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 access-1.3 {TclAccess: Use "file access ?" to invoke each procedure.} { list \ [file exists testAccess2%.fil] \ [file exists testAccess1%.fil] \ [file exists testAccess3%.fil] } {1 1 1} test access-1.4 {TclAccessDeleteProc: "TclpAccess" function should not be deletedable.} { catch {testaccessproc delete TclpAccess} err2 set err2 } {"TclpAccess": could not be deleteed} test accesst-1.5 {TclAccessDeleteProc: Delete the 2nd TclAccess procedure.} { # 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 access-1.6 {TclAccessDeleteProc: Delete the 1st TclAccess procedure.} { # 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 access-1.7 {TclAccessDeleteProc: Delete the 3rd procedure & verify all are gone.} { # 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 access-1.8 {TclAccessDeleteProc: Verify that all procs have been deleted.} { # 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}} } test openfilechannel-1.1 {TclOpenFileChannel: Check that none of the test procs are there.} { 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} if {[info commands testopenfilechannelproc] == {}} { puts "This application hasn't been compiled with the \"testopenfilechannelproc\"" puts "command, so I can't test Tcl_OpenFileChannelInsert" } else { test openfilechannel-1.2 {TclOpenFileChannelInsertProc: Insert the 3 test TclOpenFileChannel_ procedures.} { 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 openfilechannel-1.3 {TclOpenFileChannel: Use "file openfilechannel ?" to invoke each procedure.} { 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 openfilechannel-1.4 {TclOpenFileChannelDeleteProc: "TclpOpenFileChannel" function should not be deletedable.} { catch {testopenfilechannelproc delete TclpOpenFileChannel} err2 set err2 } {"TclpOpenFileChannel": could not be deleteed} test openfilechannelt-1.5 {TclOpenFileChannelDeleteProc: Delete the 2nd TclOpenFileChannel procedure.} { # 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]} close [open testOpenFileChannel3%.fil r] } err3 file delete __testOpenFileChannel1%__.fil file delete __testOpenFileChannel3%__.fil set err3 } {} test openfilechannel-1.6 {TclOpenFileChannelDeleteProc: Delete the 1st TclOpenFileChannel procedure.} { # 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]} catch {close [open testOpenFileChannel2%.fil r]} close [open testOpenFileChannel3%.fil r] } err4 file delete __testOpenFileChannel3%__.fil set err4 } {} test openfilechannel-1.7 {TclOpenFileChannelDeleteProc: Delete the 3rd procedure & verify all are gone.} { # Finally delete the 3rd procedure and check that none of the # procedures exist. testopenfilechannelproc delete TestOpenFileChannelProc3 catch { catch [open testOpenFileChannel1%.fil r] catch [open testOpenFileChannel2%.fil r] catch [open testOpenFileChannel3%.fil r] } err5 set err5 } {1} test openfilechannel-1.8 {TclOpenFileChannelDeleteProc: Verify that all procs have been deleted.} { # 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}} }