summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclTest.c300
-rw-r--r--tests/ioUtil.test256
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}}