开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
ioUtil.test
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：13k
源码类别：

通讯编程

开发平台：

Visual C++

ioUtil.test：源码内容
  1. # This file (ioUtil.test) tests the hookable TclStat(), TclAccess(),
  2. # and Tcl_OpenFileChannel, routines in the file generic/tclIOUtils.c.
  3. # Sourcing this file into Tcl runs the tests and generates output for
  4. # errors. No output means no errors were found. 
  5. # 
  6. # Copyright (c) 1998-1999 by Scriptics Corporation. 
  7. # 
  8. # See the file "license.terms" for information on usage and redistribution 
  9. # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 
  10. # 
  11. # RCS: @(#) $Id: ioUtil.test,v 1.13.2.2 2007/12/14 02:29:22 hobbs Exp $
  12.  
  13. if {[lsearch [namespace children] ::tcltest] == -1} {
  14.     package require tcltest 2
  15.     namespace import -force ::tcltest::*
  16. }
  18. ::tcltest::testConstraint testopenfilechannelproc 
  19. [llength [info commands testopenfilechannelproc]]
  20. ::tcltest::testConstraint testaccessproc 
  21. [llength [info commands testaccessproc]]
  22. ::tcltest::testConstraint teststatproc 
  23. [llength [info commands teststatproc]]
  25. set unsetScript {
  26.     catch {unset testStat1(size)}
  27.     catch {unset testStat2(size)}
  28.     catch {unset testStat3(size)}
  29. }
  31. test ioUtil-1.1 {TclStat: Check that none of the test procs are there.} {} {
  32.     catch {file stat testStat1%.fil testStat1} err1
  33.     catch {file stat testStat2%.fil testStat2} err2
  34.     catch {file stat testStat3%.fil testStat3} err3
  35.     list $err1 $err2 $err3
  36. } {{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}}
  38. test ioUtil-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} {teststatproc} {
  39.     catch {teststatproc insert TclpStat} err1
  40.     teststatproc insert TestStatProc1
  41.     teststatproc insert TestStatProc2
  42.     teststatproc insert TestStatProc3
  43.     set err1
  44. } {bad arg "insert": must be TestStatProc1, TestStatProc2, or TestStatProc3}
  46. test ioUtil-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} {teststatproc} {
  47.     file stat testStat2%.fil testStat2
  48.     file stat testStat1%.fil testStat1
  49.     file stat testStat3%.fil testStat3
  51.     list $testStat2(size) $testStat1(size) $testStat3(size)
  52. } {2345 1234 3456}
  54. eval $unsetScript
  56. test ioUtil-1.4 {TclStatDeleteProc: "TclpStat" function should not be deletable.} {teststatproc} {
  57.     catch {teststatproc delete TclpStat} err2
  58.     set err2
  59. } {"TclpStat": could not be deleteed}
  61. test ioUtil-1.5 {TclStatDeleteProc: Delete the 2nd TclStat procedure.} {teststatproc} {
  62.     # Delete the 2nd procedure and test that it longer exists but that
  63.     #   the others do actually return a result.
  65.     teststatproc delete TestStatProc2
  66.     file stat testStat1%.fil testStat1
  67.     catch {file stat testStat2%.fil testStat2} err3
  68.     file stat testStat3%.fil testStat3
  70.     list $testStat1(size) $err3 $testStat3(size)
  71. } {1234 {could not read "testStat2%.fil": no such file or directory} 3456}
  73. eval $unsetScript
  75. test ioUtil-1.6 {TclStatDeleteProc: Delete the 1st TclStat procedure.} {teststatproc} {
  76.     # Next delete the 1st procedure and test that only the 3rd procedure
  77.     #   is the only one that exists.
  79.     teststatproc delete TestStatProc1
  80.     catch {file stat testStat1%.fil testStat1} err4
  81.     catch {file stat testStat2%.fil testStat2} err5
  82.     file stat testStat3%.fil testStat3
  84.     list $err4 $err5 $testStat3(size)
  85. } {{could not read "testStat1%.fil": no such file or directory} {could not read "testStat2%.fil": no such file or directory} 3456}
  87. eval $unsetScript
  89. test ioUtil-1.7 {TclStatDeleteProc: Delete the 3rd procedure & verify all are gone.} {teststatproc} {
  90.     # Finally delete the 3rd procedure and check that none of the
  91.     #   procedures exist.
  93.     teststatproc delete TestStatProc3
  94.     catch {file stat testStat1%.fil testStat1} err6
  95.     catch {file stat testStat2%.fil testStat2} err7
  96.     catch {file stat testStat3%.fil testStat3} err8
  98.     list $err6 $err7 $err8
  99. } {{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}}
  101. eval $unsetScript
  103. test ioUtil-1.8 {TclStatDeleteProc: Verify that all procs have been deleted.} {teststatproc} {
  104.     # Attempt to delete all the Stat procs. again to ensure they no longer
  105.     #   exist and an error is returned.
  107.     catch {teststatproc delete TestStatProc1} err9
  108.     catch {teststatproc delete TestStatProc2} err10
  109.     catch {teststatproc delete TestStatProc3} err11
  111.     list $err9 $err10 $err11
  112. } {{"TestStatProc1": could not be deleteed} {"TestStatProc2": could not be deleteed} {"TestStatProc3": could not be deleteed}}
  114. eval $unsetScript
  116. test ioUtil-1.9 {TclAccess: Check that none of the test procs are there.} {
  117.     catch {file exists testAccess1%.fil} err1
  118.     catch {file exists testAccess2%.fil} err2
  119.     catch {file exists testAccess3%.fil} err3
  120.     list $err1 $err2 $err3
  121. } {0 0 0}
  123. test ioUtil-1.10 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.} {testaccessproc} {
  124.     catch {testaccessproc insert TclpAccess} err1
  125.     testaccessproc insert TestAccessProc1
  126.     testaccessproc insert TestAccessProc2
  127.     testaccessproc insert TestAccessProc3
  128.     set err1
  129. } {bad arg "insert": must be TestAccessProc1, TestAccessProc2, or TestAccessProc3}
  131. test ioUtil-2.3 {TclAccess: Use "file access ?" to invoke each procedure.} {testaccessproc} {
  132.     list [file exists testAccess2%.fil] 
  133.     [file exists testAccess1%.fil] 
  134.     [file exists testAccess3%.fil]
  135. } {1 1 1}
  137. test ioUtil-2.4 {TclAccessDeleteProc: "TclpAccess" function should not be deletable.} {testaccessproc} {
  138.     catch {testaccessproc delete TclpAccess} err2
  139.     set err2
  140. } {"TclpAccess": could not be deleteed}
  142. test ioUtil-2.5 {TclAccessDeleteProc: Delete the 2nd TclAccess procedure.} {testaccessproc} {
  143.     # Delete the 2nd procedure and test that it longer exists but that
  144.     # the others do actually return a result.
  146.     testaccessproc delete TestAccessProc2
  147.     set res1 [file exists testAccess1%.fil]
  148.     catch {file exists testAccess2%.fil} err3
  149.     set res2 [file exists testAccess3%.fil]
  151.     list $res1 $err3 $res2
  152. } {1 0 1}
  154. test ioUtil-2.6 {TclAccessDeleteProc: Delete the 1st TclAccess procedure.} {testaccessproc} {
  155.     # Next delete the 1st procedure and test that only the 3rd procedure
  156.     #   is the only one that exists.
  158.     testaccessproc delete TestAccessProc1
  159.     catch {file exists testAccess1%.fil} err4
  160.     catch {file exists testAccess2%.fil} err5
  161.     set res3 [file exists testAccess3%.fil]
  163.     list $err4 $err5 $res3
  164. } {0 0 1}
  166. test ioUtil-2.7 {TclAccessDeleteProc: Delete the 3rd procedure & verify all are gone.} {testaccessproc} {
  167.     # Finally delete the 3rd procedure and check that none of the
  168.     #   procedures exist.
  170.     testaccessproc delete TestAccessProc3
  171.     catch {file exists testAccess1%.fil} err6
  172.     catch {file exists testAccess2%.fil} err7
  173.     catch {file exists testAccess3%.fil} err8
  175.     list $err6 $err7 $err8
  176. } {0 0 0}
  178. test ioUtil-2.8 {TclAccessDeleteProc: Verify that all procs have been deleted.} {testaccessproc} {
  179.     # Attempt to delete all the Access procs. again to ensure they no longer
  180.     #   exist and an error is returned.
  182.     catch {testaccessproc delete TestAccessProc1} err9
  183.     catch {testaccessproc delete TestAccessProc2} err10
  184.     catch {testaccessproc delete TestAccessProc3} err11
  186.     list $err9 $err10 $err11
  187. } {{"TestAccessProc1": could not be deleteed} {"TestAccessProc2": could not be deleteed} {"TestAccessProc3": could not be deleteed}}
  189. # Some of the following tests require a writable current directory
  190. set oldpwd [pwd]
  191. cd [temporaryDirectory]
  193. test ioUtil-3.1 {TclOpenFileChannel: Check that none of the test procs are there.} {testopenfilechannelproc} {
  194.     catch {eval [list file delete -force] [glob *testOpenFileChannel*]}
  195.     catch {file exists testOpenFileChannel1%.fil} err1
  196.     catch {file exists testOpenFileChannel2%.fil} err2
  197.     catch {file exists testOpenFileChannel3%.fil} err3
  198.     catch {file exists __testOpenFileChannel1%__.fil} err4
  199.     catch {file exists __testOpenFileChannel2%__.fil} err5
  200.     catch {file exists __testOpenFileChannel3%__.fil} err6
  201.     list $err1 $err2 $err3 $err4 $err5 $err6
  202. } {0 0 0 0 0 0}
  204. test ioUtil-3.2 {TclOpenFileChannelInsertProc: Insert the 3 test TclOpenFileChannel_ procedures.} {testopenfilechannelproc} {
  205.     catch {testopenfilechannelproc insert TclpOpenFileChannel} err1
  206.     testopenfilechannelproc insert TestOpenFileChannelProc1
  207.     testopenfilechannelproc insert TestOpenFileChannelProc2
  208.     testopenfilechannelproc insert TestOpenFileChannelProc3
  209.     set err1
  210. } {bad arg "insert": must be TestOpenFileChannelProc1, TestOpenFileChannelProc2, or TestOpenFileChannelProc3}
  212. test ioUtil-3.3 {TclOpenFileChannel: Use "file openfilechannel ?" to invoke each procedure.} {testopenfilechannelproc} {
  213.     close [open __testOpenFileChannel1%__.fil w]
  214.     close [open __testOpenFileChannel2%__.fil w]
  215.     close [open __testOpenFileChannel3%__.fil w]
  217.     catch {
  218. close [open testOpenFileChannel1%.fil r]
  219. close [open testOpenFileChannel2%.fil r]
  220. close [open testOpenFileChannel3%.fil r]
  221.     } err
  223.     file delete __testOpenFileChannel1%__.fil
  224.     file delete __testOpenFileChannel2%__.fil
  225.     file delete __testOpenFileChannel3%__.fil
  227.     set err
  228. } {}
  230. test ioUtil-3.4 {TclOpenFileChannelDeleteProc: "TclpOpenFileChannel" function should not be deletable.} {testopenfilechannelproc} {
  231.     catch {testopenfilechannelproc delete TclpOpenFileChannel} err2
  232.     set err2
  233. } {"TclpOpenFileChannel": could not be deleteed}
  235. test ioUtil-3.5 {TclOpenFileChannelDeleteProc: Delete the 2nd TclOpenFileChannel procedure.} {testopenfilechannelproc} {
  236.     # Delete the 2nd procedure and test that it longer exists but that
  237.     #   the others do actually return a result.
  239.     testopenfilechannelproc delete TestOpenFileChannelProc2
  241.     close [open __testOpenFileChannel1%__.fil w]
  242.     close [open __testOpenFileChannel3%__.fil w]
  244.     catch {
  245. close [open testOpenFileChannel1%.fil r]
  246. catch {close [open testOpenFileChannel2%.fil r]} msg1
  247. close [open testOpenFileChannel3%.fil r]
  248.     } err3
  250.     file delete __testOpenFileChannel1%__.fil
  251.     file delete __testOpenFileChannel3%__.fil
  253.     list $err3 $msg1
  254. } {{} {couldn't open "testOpenFileChannel2%.fil": no such file or directory}}
  256. test ioUtil-3.6 {TclOpenFileChannelDeleteProc: Delete the 1st TclOpenFileChannel procedure.} {testopenfilechannelproc} {
  257.     # Next delete the 1st procedure and test that only the 3rd procedure
  258.     #   is the only one that exists.
  260.     testopenfilechannelproc delete TestOpenFileChannelProc1
  262.     close [open __testOpenFileChannel3%__.fil w]
  264.     catch {
  265. catch {close [open testOpenFileChannel1%.fil r]} msg2
  266. catch {close [open testOpenFileChannel2%.fil r]} msg3
  267. close [open testOpenFileChannel3%.fil r]
  268.     } err4
  270.     file delete __testOpenFileChannel3%__.fil
  272.     list $err4 $msg2 $msg3
  273. } [list {} 
  274. {couldn't open "testOpenFileChannel1%.fil": no such file or directory}
  275. {couldn't open "testOpenFileChannel2%.fil": no such file or directory}]
  277. test ioUtil-3.7 {TclOpenFileChannelDeleteProc: Delete the 3rd procedure & verify all are gone.} {testopenfilechannelproc} {
  278.     # Finally delete the 3rd procedure and check that none of the
  279.     #   procedures exist.
  281.     testopenfilechannelproc delete TestOpenFileChannelProc3
  282.     catch {
  283. catch {close [open testOpenFileChannel1%.fil r]} msg4
  284. catch {close [open testOpenFileChannel2%.fil r]} msg5
  285. catch {close [open testOpenFileChannel3%.fil r]} msg6
  286.     } err5
  288.     list $err5 $msg4 $msg5 $msg6
  289. } [list 1 
  290. {couldn't open "testOpenFileChannel1%.fil": no such file or directory}
  291. {couldn't open "testOpenFileChannel2%.fil": no such file or directory}
  292. {couldn't open "testOpenFileChannel3%.fil": no such file or directory}]
  294. test ioUtil-3.8 {TclOpenFileChannelDeleteProc: Verify that all procs have been deleted.} {testopenfilechannelproc} {
  296.     # Attempt to delete all the OpenFileChannel procs. again to ensure they no
  297.     # longer exist and an error is returned.
  299.     catch {testopenfilechannelproc delete TestOpenFileChannelProc1} err9
  300.     catch {testopenfilechannelproc delete TestOpenFileChannelProc2} err10
  301.     catch {testopenfilechannelproc delete TestOpenFileChannelProc3} err11
  303.     list $err9 $err10 $err11
  304. } {{"TestOpenFileChannelProc1": could not be deleteed} {"TestOpenFileChannelProc2": could not be deleteed} {"TestOpenFileChannelProc3": could not be deleteed}}
  306. test ioUtil-4.1 {open ... a+ must not use O_APPEND: Bug 1773127} -setup {
  307.     set f [tcltest::makeFile {} ioutil41.tmp]
  308.     set fid [open $f w]
  309.     puts -nonewline $fid 123
  310.     close $fid
  311. } -body {
  312.     set fid [open $f a+]
  313.     puts -nonewline $fid 456
  314.     seek $fid 2
  315.     set d [read $fid 2]
  316.     seek $fid 4
  317.     puts -nonewline $fid x
  318.     close $fid
  319.     set fid [open $f r]
  320.     append d [read $fid]
  321.     close $fid
  322.     return $d
  323. } -cleanup {
  324.     tcltest::removeFile $f
  325. } -result 341234x6
  327. cd $oldpwd
  329. # cleanup
  330. ::tcltest::cleanupTests
  331. return