diff options
| -rw-r--r-- | generic/tclTest.c | 300 | ||||
| -rw-r--r-- | tests/ioUtil.test | 256 |
2 files changed, 500 insertions, 56 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index 8d69d35..12893db 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -121,6 +121,14 @@ static int NoopObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static void SpecialFree _ANSI_ARGS_((char *blockPtr)); static int StaticInitProc _ANSI_ARGS_((Tcl_Interp *interp)); +static int TestaccessprocCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int argc, char **argv)); +static int TestAccessProc1 _ANSI_ARGS_((CONST char *path, + int mode)); +static int TestAccessProc2 _ANSI_ARGS_((CONST char *path, + int mode)); +static int TestAccessProc3 _ANSI_ARGS_((CONST char *path, + int mode)); static int TestasyncCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); static int TestcmdinfoCmd _ANSI_ARGS_((ClientData dummy, @@ -168,6 +176,12 @@ static int TestMathFunc _ANSI_ARGS_((ClientData clientData, static int TestMathFunc2 _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)); +static Tcl_Channel TestOpenFileChannelProc1 _ANSI_ARGS_((Tcl_Interp *interp, + char *filename, char *modeString, int permissions)); +static Tcl_Channel TestOpenFileChannelProc2 _ANSI_ARGS_((Tcl_Interp *interp, + char *filename, char *modeString, int permissions)); +static Tcl_Channel TestOpenFileChannelProc3 _ANSI_ARGS_((Tcl_Interp *interp, + char *filename, char *modeString, int permissions)); static int TestPanicCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); static int TestsetassocdataCmd _ANSI_ARGS_((ClientData dummy, @@ -177,6 +191,8 @@ static int TestsetnoerrCmd _ANSI_ARGS_((ClientData dummy, static int TestsetobjerrorcodeCmd _ANSI_ARGS_(( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +static int TestopenfilechannelprocCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int argc, char **argv)); static int TestsetplatformCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); static int TestsetrecursionlimitCmd _ANSI_ARGS_(( @@ -184,13 +200,13 @@ static int TestsetrecursionlimitCmd _ANSI_ARGS_(( int objc, Tcl_Obj *CONST objv[])); static int TeststaticpkgCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); -static int TestTclStatProc1 _ANSI_ARGS_((CONST char *path, +static int TestStatProc1 _ANSI_ARGS_((CONST char *path, TclStat_ *buf)); -static int TestTclStatProc2 _ANSI_ARGS_((CONST char *path, +static int TestStatProc2 _ANSI_ARGS_((CONST char *path, TclStat_ *buf)); -static int TestTclStatProc3 _ANSI_ARGS_((CONST char *path, +static int TestStatProc3 _ANSI_ARGS_((CONST char *path, TclStat_ *buf)); -static int TestTclStatCmd _ANSI_ARGS_((ClientData dummy, +static int TeststatprocCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); static int TesttranslatefilenameCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); @@ -244,6 +260,8 @@ Tcltest_Init(interp) (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateCommand(interp, "testaccessproc", TestaccessprocCmd, (ClientData) 0, + (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testasync", TestasyncCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testchannel", TclTestChannelCmd, @@ -288,6 +306,9 @@ Tcltest_Init(interp) (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testlink", TestlinkCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateCommand(interp, "testopenfilechannelproc", + TestopenfilechannelprocCmd, (ClientData) 0, + (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testsetnoerr", TestsetnoerrCmd, @@ -319,7 +340,7 @@ Tcltest_Init(interp) (ClientData) 123); Tcl_CreateMathFunc(interp, "T2", 0, (Tcl_ValueType *) NULL, TestMathFunc, (ClientData) 345); - Tcl_CreateCommand(interp, "testTclStat", TestTclStatCmd, (ClientData) 0, + Tcl_CreateCommand(interp, "teststatproc", TeststatprocCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); t3ArgTypes[0] = TCL_EITHER; t3ArgTypes[1] = TCL_EITHER; @@ -2732,7 +2753,7 @@ TestsetnoerrCmd(dummy, interp, argc, argv) /* *---------------------------------------------------------------------- * - * TestTclStatCmd -- + * TeststatprocCmd -- * * Implements the "testTclStatProc" cmd that is used to test the * 'TclStatInsertProc' C Api. @@ -2747,7 +2768,7 @@ TestsetnoerrCmd(dummy, interp, argc, argv) */ static int -TestTclStatCmd (dummy, interp, argc, argv) +TeststatprocCmd (dummy, interp, argc, argv) ClientData dummy; /* Not used. */ register Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ @@ -2764,16 +2785,16 @@ TestTclStatCmd (dummy, interp, argc, argv) if (strcmp(argv[2], "TclpStat") == 0) { proc = TclpStat; - } else if (strcmp(argv[2], "TestTclStatProc1") == 0) { - proc = TestTclStatProc1; - } else if (strcmp(argv[2], "TestTclStatProc2") == 0) { - proc = TestTclStatProc2; - } else if (strcmp(argv[2], "TestTclStatProc3") == 0) { - proc = TestTclStatProc3; + } else if (strcmp(argv[2], "TestStatProc1") == 0) { + proc = TestStatProc1; + } else if (strcmp(argv[2], "TestStatProc2") == 0) { + proc = TestStatProc2; + } else if (strcmp(argv[2], "TestStatProc3") == 0) { + proc = TestStatProc3; } else { Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ", "must be TclpStat, ", - "TestTclStatProc1, TestTclStatProc2, or TestTclStatProc3", + "TestStatProc1, TestStatProc2, or TestStatProc3", (char *) NULL); return TCL_ERROR; } @@ -2782,7 +2803,7 @@ TestTclStatCmd (dummy, interp, argc, argv) if (proc == TclpStat) { Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ", "must be ", - "TestTclStatProc1, TestTclStatProc2, or TestTclStatProc3", + "TestStatProc1, TestStatProc2, or TestStatProc3", (char *) NULL); return TCL_ERROR; } @@ -2805,30 +2826,267 @@ TestTclStatCmd (dummy, interp, argc, argv) static int -TestTclStatProc1(path, buf) +TestStatProc1(path, buf) CONST char *path; TclStat_ *buf; { buf->st_size = 1234; - return (strcmp("testTclStat1%.fil", path) ? -1 : 0); + return (strcmp("testStat1%.fil", path) ? -1 : 0); } static int -TestTclStatProc2(path, buf) +TestStatProc2(path, buf) CONST char *path; TclStat_ *buf; { buf->st_size = 2345; - return (strcmp("testTclStat2%.fil", path) ? -1 : 0); + return (strcmp("testStat2%.fil", path) ? -1 : 0); } static int -TestTclStatProc3(path, buf) +TestStatProc3(path, buf) CONST char *path; TclStat_ *buf; { buf->st_size = 3456; - return (strcmp("testTclStat3%.fil", path) ? -1 : 0); + return (strcmp("testStat3%.fil", path) ? -1 : 0); +} + +/* + *---------------------------------------------------------------------- + * + * TestaccessprocCmd -- + * + * Implements the "testTclAccessProc" cmd that is used to test the + * 'TclAccessInsertProc' C Api. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestaccessprocCmd (dummy, interp, argc, argv) + ClientData dummy; /* Not used. */ + register Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + TclAccessProc_ *proc; + int retVal; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option arg\"", (char *) NULL); + return TCL_ERROR; + } + + if (strcmp(argv[2], "TclpAccess") == 0) { + proc = TclpAccess; + } else if (strcmp(argv[2], "TestAccessProc1") == 0) { + proc = TestAccessProc1; + } else if (strcmp(argv[2], "TestAccessProc2") == 0) { + proc = TestAccessProc2; + } else if (strcmp(argv[2], "TestAccessProc3") == 0) { + proc = TestAccessProc3; + } else { + Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ", + "must be TclpAccess, ", + "TestAccessProc1, TestAccessProc2, or TestAccessProc3", + (char *) NULL); + return TCL_ERROR; + } + + if (strcmp(argv[1], "insert") == 0) { + if (proc == TclpAccess) { + Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ", + "must be ", + "TestAccessProc1, TestAccessProc2, or TestAccessProc3", + (char *) NULL); + return TCL_ERROR; + } + retVal = TclAccessInsertProc(proc); + } else if (strcmp(argv[1], "delete") == 0) { + retVal = TclAccessDeleteProc(proc); + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], "\": ", + "must be insert or delete", (char *) NULL); + return TCL_ERROR; + } + + if (retVal == TCL_ERROR) { + Tcl_AppendResult(interp, "\"", argv[2], "\": ", + "could not be ", argv[1], "ed", (char *) NULL); + } + + return retVal; +} + + +static int +TestAccessProc1(path, mode) + CONST char *path; + int mode; +{ + return (strcmp("testAccess1%.fil", path) ? -1 : 0); +} + + +static int +TestAccessProc2(path, mode) + CONST char *path; + int mode; +{ + return (strcmp("testAccess2%.fil", path) ? -1 : 0); +} + + +static int +TestAccessProc3(path, mode) + CONST char *path; + int mode; +{ + return (strcmp("testAccess3%.fil", path) ? -1 : 0); +} + +/* + *---------------------------------------------------------------------- + * + * TestopenfilechannelprocCmd -- + * + * Implements the "testTclOpenFileChannelProc" cmd that is used to test the + * 'TclAccessInsertProc' C Api. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestopenfilechannelprocCmd (dummy, interp, argc, argv) + ClientData dummy; /* Not used. */ + register Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ +{ + TclOpenFileChannelProc_ *proc; + int retVal; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option arg\"", (char *) NULL); + return TCL_ERROR; + } + + if (strcmp(argv[2], "TclpOpenFileChannel") == 0) { + proc = TclpOpenFileChannel; + } else if (strcmp(argv[2], "TestOpenFileChannelProc1") == 0) { + proc = TestOpenFileChannelProc1; + } else if (strcmp(argv[2], "TestOpenFileChannelProc2") == 0) { + proc = TestOpenFileChannelProc2; + } else if (strcmp(argv[2], "TestOpenFileChannelProc3") == 0) { + proc = TestOpenFileChannelProc3; + } else { + Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ", + "must be TclpOpenFileChannel, ", + "TestOpenFileChannelProc1, TestOpenFileChannelProc2, or ", + "TestOpenFileChannelProc3", + (char *) NULL); + return TCL_ERROR; + } + + if (strcmp(argv[1], "insert") == 0) { + if (proc == TclpOpenFileChannel) { + Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ", + "must be ", + "TestOpenFileChannelProc1, TestOpenFileChannelProc2, or ", + "TestOpenFileChannelProc3", + (char *) NULL); + return TCL_ERROR; + } + retVal = TclOpenFileChannelInsertProc(proc); + } else if (strcmp(argv[1], "delete") == 0) { + retVal = TclOpenFileChannelDeleteProc(proc); + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], "\": ", + "must be insert or delete", (char *) NULL); + return TCL_ERROR; + } + + if (retVal == TCL_ERROR) { + Tcl_AppendResult(interp, "\"", argv[2], "\": ", + "could not be ", argv[1], "ed", (char *) NULL); + } + + return retVal; +} + + +static Tcl_Channel +TestOpenFileChannelProc1(interp, fileName, modeString, permissions) + Tcl_Interp *interp; /* Interpreter for error reporting; + * can be NULL. */ + char *fileName; /* Name of file to open. */ + char *modeString; /* A list of POSIX open modes or + * a string such as "rw". */ + int permissions; /* If the open involves creating a + * file, with what modes to create + * it? */ +{ + if (!strcmp("testOpenFileChannel1%.fil", fileName)) { + return (TclpOpenFileChannel(interp, "__testOpenFileChannel1%__.fil", + modeString, permissions)); + } else { + return (NULL); + } +} + + +static Tcl_Channel +TestOpenFileChannelProc2(interp, fileName, modeString, permissions) + Tcl_Interp *interp; /* Interpreter for error reporting; + * can be NULL. */ + char *fileName; /* Name of file to open. */ + char *modeString; /* A list of POSIX open modes or + * a string such as "rw". */ + int permissions; /* If the open involves creating a + * file, with what modes to create + * it? */ +{ + if (!strcmp("testOpenFileChannel2%.fil", fileName)) { + return (TclpOpenFileChannel(interp, "__testOpenFileChannel2%__.fil", + modeString, permissions)); + } else { + return (NULL); + } +} + + +static Tcl_Channel +TestOpenFileChannelProc3(interp, fileName, modeString, permissions) + Tcl_Interp *interp; /* Interpreter for error reporting; + * can be NULL. */ + char *fileName; /* Name of file to open. */ + char *modeString; /* A list of POSIX open modes or + * a string such as "rw". */ + int permissions; /* If the open involves creating a + * file, with what modes to create + * it? */ +{ + if (!strcmp("testOpenFileChannel3%.fil", fileName)) { + return (TclpOpenFileChannel(interp, "__testOpenFileChannel3%__.fil", + modeString, permissions)); + } else { + return (NULL); + } } diff --git a/tests/ioUtil.test b/tests/ioUtil.test index 03b7caf..2b2e60d 100644 --- a/tests/ioUtil.test +++ b/tests/ioUtil.test @@ -1,5 +1,5 @@ -# This file (iOUtil.test) tests the hookable TclStat(), @@@TclAccess(), -# and @@@Tcl_OpenFileChannel, routines in the file generic/tclIOUtils.c. +# 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. # @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# SCCS: %Z% $Id: ioUtil.test,v 1.1 1998/06/04 12:44:44 suresh Exp $ +# SCCS: %Z% $Id: ioUtil.test,v 1.2 1998/07/13 14:04:50 suresh Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -19,24 +19,24 @@ set unsetScript { } test stat-1.1 {TclStat: Check that none of the test procs are there.} { - catch {file stat testTclStat1%.fil testStat1} err1 - catch {file stat testTclStat2%.fil testStat2} err2 - catch {file stat testTclStat3%.fil testStat3} err3 + 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 "testTclStat1%.fil": no such file or directory} {couldn't stat "testTclStat2%.fil": no such file or directory} {couldn't stat "testTclStat3%.fil": no such file or directory}} +} {{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}} test stat-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} { - catch {testTclStat insert TclpStat} err1 - testTclStat insert TestTclStatProc1 - testTclStat insert TestTclStatProc2 - testTclStat insert TestTclStatProc3 + catch {teststatproc insert TclpStat} err1 + teststatproc insert TestStatProc1 + teststatproc insert TestStatProc2 + teststatproc insert TestStatProc3 set err1 -} {bad arg "insert": must be TestTclStatProc1, TestTclStatProc2, or TestTclStatProc3} +} {bad arg "insert": must be TestStatProc1, TestStatProc2, or TestStatProc3} test stat-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} { - file stat testTclStat2%.fil testStat2 - file stat testTclStat1%.fil testStat1 - file stat testTclStat3%.fil testStat3 + 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} @@ -44,57 +44,243 @@ test stat-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} { eval $unsetScript test stat-1.4 {TclStatDeleteProc: "TclpStat" function should not be deletedable.} { - catch {testTclStat delete TclpStat} err2 + 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. - testTclStat delete TestTclStatProc2 - file stat testTclStat1%.fil testStat1 - catch {file stat testTclStat2%.fil testStat2} err3 - file stat testTclStat3%.fil testStat3 +
+ 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 "testTclStat2%.fil": no such file or directory} 3456} +} {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. - testTclStat delete TestTclStatProc1 - catch {file stat testTclStat1%.fil testStat1} err4 - catch {file stat testTclStat2%.fil testStat2} err5 - file stat testTclStat3%.fil testStat3 +
+ 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 "testTclStat1%.fil": no such file or directory} {couldn't stat "testTclStat2%.fil": no such file or directory} 3456} +} {{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. - testTclStat delete TestTclStatProc3 - catch {file stat testTclStat1%.fil testStat1} err6 - catch {file stat testTclStat2%.fil testStat2} err7 - catch {file stat testTclStat3%.fil testStat3} err8 +
+ 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 "testTclStat1%.fil": no such file or directory} {couldn't stat "testTclStat2%.fil": no such file or directory} {couldn't stat "testTclStat3%.fil": no such file or directory}} +} {{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 {testTclStat delete TestTclStatProc1} err9 - catch {testTclStat delete TestTclStatProc2} err10 - catch {testTclStat delete TestTclStatProc3} err11 +
+ catch {teststatproc delete TestStatProc1} err9 + catch {teststatproc delete TestStatProc2} err10 + catch {teststatproc delete TestStatProc3} err11 list $err9 $err10 $err11 -} {{"TestTclStatProc1": could not be deleteed} {"TestTclStatProc2": could not be deleteed} {"TestTclStatProc3": could not be deleteed}} +} {{"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} + +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} + +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}}
|