332 lines
13 KiB
Plaintext
332 lines
13 KiB
Plaintext
# 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.
|
|
|
|
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:
|