Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/ioUtil.test@bde4ae8d615e

     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.1 2003/04/14 15:45:57 vincentdarley Exp $

    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 cd $oldpwd

   308 # cleanup

   309 ::tcltest::cleanupTests

   310 return

author	sl@SLION-WIN7.fritz.box
	Fri, 15 Jun 2012 03:10:57 +0200
changeset 0	bde4ae8d615e
permissions	-rw-r--r--