summaryrefslogtreecommitdiffstats
path: root/generic/tclTest.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r--generic/tclTest.c536
1 files changed, 1 insertions, 535 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 7f48903..a810a55 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTest.c,v 1.114 2008/03/14 16:32:52 rmax Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.115 2008/04/21 16:26:38 dgp Exp $
*/
#define TCL_TEST
@@ -202,36 +202,6 @@ static void ObjTraceDeleteProc(ClientData clientData);
static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr);
static void SpecialFree(char *blockPtr);
static int StaticInitProc(Tcl_Interp *interp);
-#undef USE_OBSOLETE_FS_HOOKS
-#ifdef USE_OBSOLETE_FS_HOOKS
-static int TestaccessprocCmd(ClientData dummy,
- Tcl_Interp *interp, int argc, const char **argv);
-static int TestopenfilechannelprocCmd(
- ClientData dummy, Tcl_Interp *interp, int argc,
- const char **argv);
-static int TeststatprocCmd(ClientData dummy,
- Tcl_Interp *interp, int argc, const char **argv);
-static int PretendTclpAccess(const char *path, int mode);
-static int TestAccessProc1(const char *path, int mode);
-static int TestAccessProc2(const char *path, int mode);
-static int TestAccessProc3(const char *path, int mode);
-static Tcl_Channel PretendTclpOpenFileChannel(
- Tcl_Interp *interp, const char *fileName,
- const char *modeString, int permissions);
-static Tcl_Channel TestOpenFileChannelProc1(
- Tcl_Interp *interp, const char *fileName,
- const char *modeString, int permissions);
-static Tcl_Channel TestOpenFileChannelProc2(
- Tcl_Interp *interp, const char *fileName,
- const char *modeString, int permissions);
-static Tcl_Channel TestOpenFileChannelProc3(
- Tcl_Interp *interp, const char *fileName,
- const char *modeString, int permissions);
-static int PretendTclpStat(const char *path, struct stat *buf);
-static int TestStatProc1(const char *path, struct stat *buf);
-static int TestStatProc2(const char *path, struct stat *buf);
-static int TestStatProc3(const char *path, struct stat *buf);
-#endif
static int TestasyncCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
static int TestcmdinfoCmd(ClientData dummy,
@@ -578,14 +548,6 @@ Tcltest_Init(
(ClientData) 0, NULL);
Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct",
TestGetIndexFromObjStructObjCmd, (ClientData) 0, NULL);
-#ifdef USE_OBSOLETE_FS_HOOKS
- Tcl_CreateCommand(interp, "testaccessproc", TestaccessprocCmd, (ClientData) 0,
- NULL);
- Tcl_CreateCommand(interp, "testopenfilechannelproc",
- TestopenfilechannelprocCmd, (ClientData) 0, NULL);
- Tcl_CreateCommand(interp, "teststatproc", TeststatprocCmd, (ClientData) 0,
- NULL);
-#endif
Tcl_CreateCommand(interp, "testasync", TestasyncCmd, (ClientData) 0, NULL);
Tcl_CreateCommand(interp, "testchannel", TestChannelCmd,
(ClientData) 0, NULL);
@@ -4981,199 +4943,6 @@ TestsaveresultFree(
{
freeCount++;
}
-#ifdef USE_OBSOLETE_FS_HOOKS
-
-/*
- *----------------------------------------------------------------------
- *
- * TeststatprocCmd --
- *
- * Implements the "testTclStatProc" cmd that is used to test the
- * 'TclStatInsertProc' & 'TclStatDeleteProc' C Apis.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TeststatprocCmd(
- ClientData dummy, /* Not used. */
- register Tcl_Interp *interp,/* Current interpreter. */
- int argc, /* Number of arguments. */
- const char **argv) /* Argument strings. */
-{
- TclStatProc_ *proc;
- int retVal;
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option arg\"", NULL);
- return TCL_ERROR;
- }
-
- if (strcmp(argv[2], "TclpStat") == 0) {
- proc = PretendTclpStat;
- } 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, "
- "TestStatProc1, TestStatProc2, or TestStatProc3", NULL);
- return TCL_ERROR;
- }
-
- if (strcmp(argv[1], "insert") == 0) {
- if (proc == PretendTclpStat) {
- Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": "
- "must be "
- "TestStatProc1, TestStatProc2, or TestStatProc3", NULL);
- return TCL_ERROR;
- }
- retVal = TclStatInsertProc(proc);
- } else if (strcmp(argv[1], "delete") == 0) {
- retVal = TclStatDeleteProc(proc);
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1], "\": "
- "must be insert or delete", NULL);
- return TCL_ERROR;
- }
-
- if (retVal == TCL_ERROR) {
- Tcl_AppendResult(interp, "\"", argv[2], "\": "
- "could not be ", argv[1], "ed", NULL);
- }
-
- return retVal;
-}
-
-static int
-PretendTclpStat(
- const char *path,
- struct stat *buf)
-{
- int ret;
- Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);
-#ifdef TCL_WIDE_INT_IS_LONG
- Tcl_IncrRefCount(pathPtr);
- ret = TclpObjStat(pathPtr, buf);
- Tcl_DecrRefCount(pathPtr);
- return ret;
-#else /* TCL_WIDE_INT_IS_LONG */
- Tcl_StatBuf realBuf;
- Tcl_IncrRefCount(pathPtr);
- ret = TclpObjStat(pathPtr, &realBuf);
- Tcl_DecrRefCount(pathPtr);
- if (ret != -1) {
-# define OUT_OF_RANGE(x) \
- (((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
- ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
-#if defined(__GNUC__) && __GNUC__ >= 2
-/*
- * Workaround gcc warning of "comparison is always false due to limited range of
- * data type" in this macro by checking max type size, and when necessary ANDing
- * with the complement of ULONG_MAX instead of the comparison:
- */
-# define OUT_OF_URANGE(x) \
- ((((Tcl_WideUInt)(~ (__typeof__(x)) 0)) > (Tcl_WideUInt)ULONG_MAX) && \
- (((Tcl_WideUInt)(x)) & ~(Tcl_WideUInt)ULONG_MAX))
-#else
-# define OUT_OF_URANGE(x) \
- (((Tcl_WideUInt)(x)) > (Tcl_WideUInt)ULONG_MAX)
-#endif
-
- /*
- * Perform the result-buffer overflow check manually.
- *
- * Note that ino_t/ino64_t is unsigned...
- */
-
- if (OUT_OF_URANGE(realBuf.st_ino) || OUT_OF_RANGE(realBuf.st_size)
-# ifdef HAVE_ST_BLOCKS
- || OUT_OF_RANGE(realBuf.st_blocks)
-# endif
- ) {
-# ifdef EOVERFLOW
- errno = EOVERFLOW;
-# else
-# ifdef EFBIG
- errno = EFBIG;
-# else
-# error "what error should be returned for a value out of range?"
-# endif
-# endif
- return -1;
- }
-
-# undef OUT_OF_RANGE
-# undef OUT_OF_URANGE
-
- /*
- * Copy across all supported fields, with possible type coercions on
- * those fields that change between the normal and lf64 versions of
- * the stat structure (on Solaris at least.) This is slow when the
- * structure sizes coincide, but that's what you get for mixing
- * interfaces...
- */
-
- buf->st_mode = realBuf.st_mode;
- buf->st_ino = (ino_t) realBuf.st_ino;
- buf->st_dev = realBuf.st_dev;
- buf->st_rdev = realBuf.st_rdev;
- buf->st_nlink = realBuf.st_nlink;
- buf->st_uid = realBuf.st_uid;
- buf->st_gid = realBuf.st_gid;
- buf->st_size = (off_t) realBuf.st_size;
- buf->st_atime = realBuf.st_atime;
- buf->st_mtime = realBuf.st_mtime;
- buf->st_ctime = realBuf.st_ctime;
-# ifdef HAVE_ST_BLOCKS
- buf->st_blksize = realBuf.st_blksize;
- buf->st_blocks = (blkcnt_t) realBuf.st_blocks;
-# endif
- }
- return ret;
-#endif /* TCL_WIDE_INT_IS_LONG */
-}
-
-static int
-TestStatProc1(
- const char *path,
- struct stat *buf)
-{
- memset(buf, 0, sizeof(struct stat));
- buf->st_size = 1234;
- return ((strstr(path, "testStat1%.fil") == NULL) ? -1 : 0);
-}
-
-static int
-TestStatProc2(
- const char *path,
- struct stat *buf)
-{
- memset(buf, 0, sizeof(struct stat));
- buf->st_size = 2345;
- return ((strstr(path, "testStat2%.fil") == NULL) ? -1 : 0);
-}
-
-static int
-TestStatProc3(
- const char *path,
- struct stat *buf)
-{
- memset(buf, 0, sizeof(struct stat));
- buf->st_size = 3456;
- return ((strstr(path, "testStat3%.fil") == NULL) ? -1 : 0);
-}
-#endif
/*
*----------------------------------------------------------------------
@@ -5291,309 +5060,6 @@ TestexitmainloopCmd(
exitMainLoop = 1;
return TCL_OK;
}
-#ifdef USE_OBSOLETE_FS_HOOKS
-
-/*
- *----------------------------------------------------------------------
- *
- * TestaccessprocCmd --
- *
- * Implements the "testTclAccessProc" cmd that is used to test the
- * 'TclAccessInsertProc' & 'TclAccessDeleteProc' C Apis.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestaccessprocCmd(
- ClientData dummy, /* Not used. */
- register Tcl_Interp *interp,/* Current interpreter. */
- int argc, /* Number of arguments. */
- const char **argv) /* Argument strings. */
-{
- TclAccessProc_ *proc;
- int retVal;
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option arg\"", NULL);
- return TCL_ERROR;
- }
-
- if (strcmp(argv[2], "TclpAccess") == 0) {
- proc = PretendTclpAccess;
- } 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", NULL);
- return TCL_ERROR;
- }
-
- if (strcmp(argv[1], "insert") == 0) {
- if (proc == PretendTclpAccess) {
- Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": must be "
- "TestAccessProc1, TestAccessProc2, or TestAccessProc3"
- 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", NULL);
- return TCL_ERROR;
- }
-
- if (retVal == TCL_ERROR) {
- Tcl_AppendResult(interp, "\"", argv[2], "\": "
- "could not be ", argv[1], "ed", NULL);
- }
-
- return retVal;
-}
-
-static int
-PretendTclpAccess(
- const char *path,
- int mode)
-{
- int ret;
- Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);
- Tcl_IncrRefCount(pathPtr);
- ret = TclpObjAccess(pathPtr, mode);
- Tcl_DecrRefCount(pathPtr);
- return ret;
-}
-
-static int
-TestAccessProc1(
- const char *path,
- int mode)
-{
- return ((strstr(path, "testAccess1%.fil") == NULL) ? -1 : 0);
-}
-
-static int
-TestAccessProc2(
- const char *path,
- int mode)
-{
- return ((strstr(path, "testAccess2%.fil") == NULL) ? -1 : 0);
-}
-
-static int
-TestAccessProc3(
- const char *path,
- int mode)
-{
- return ((strstr(path, "testAccess3%.fil") == NULL) ? -1 : 0);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TestopenfilechannelprocCmd --
- *
- * Implements the "testTclOpenFileChannelProc" cmd that is used to test
- * the 'TclOpenFileChannelInsertProc' & 'TclOpenFileChannelDeleteProc' C
- * Apis.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestopenfilechannelprocCmd(
- ClientData dummy, /* Not used. */
- register Tcl_Interp *interp,/* Current interpreter. */
- int argc, /* Number of arguments. */
- const char **argv) /* Argument strings. */
-{
- TclOpenFileChannelProc_ *proc;
- int retVal;
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option arg\"", NULL);
- return TCL_ERROR;
- }
-
- if (strcmp(argv[2], "TclpOpenFileChannel") == 0) {
- proc = PretendTclpOpenFileChannel;
- } 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", NULL);
- return TCL_ERROR;
- }
-
- if (strcmp(argv[1], "insert") == 0) {
- if (proc == PretendTclpOpenFileChannel) {
- Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": "
- "must be "
- "TestOpenFileChannelProc1, TestOpenFileChannelProc2, or "
- "TestOpenFileChannelProc3", 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", NULL);
- return TCL_ERROR;
- }
-
- if (retVal == TCL_ERROR) {
- Tcl_AppendResult(interp, "\"", argv[2], "\": "
- "could not be ", argv[1], "ed", NULL);
- }
-
- return retVal;
-}
-
-static Tcl_Channel
-PretendTclpOpenFileChannel(
- Tcl_Interp *interp, /* Interpreter for error reporting; can be
- * NULL. */
- const char *fileName, /* Name of file to open. */
- const 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? */
-{
- Tcl_Channel ret;
- int mode, seekFlag;
- Tcl_Obj *pathPtr;
- mode = TclGetOpenMode(interp, modeString, &seekFlag);
- if (mode == -1) {
- return NULL;
- }
- pathPtr = Tcl_NewStringObj(fileName, -1);
- Tcl_IncrRefCount(pathPtr);
- ret = TclpOpenFileChannel(interp, pathPtr, mode, permissions);
- Tcl_DecrRefCount(pathPtr);
- if (ret != NULL) {
- if (seekFlag) {
- if (Tcl_Seek(ret, (Tcl_WideInt)0, SEEK_END) < (Tcl_WideInt)0) {
- if (interp != NULL) {
- Tcl_AppendResult(interp,
- "could not seek to end of file while opening \"",
- fileName, "\": ", Tcl_PosixError(interp), NULL);
- }
- Tcl_Close(NULL, ret);
- return NULL;
- }
- }
- }
- return ret;
-}
-
-static Tcl_Channel
-TestOpenFileChannelProc1(
- Tcl_Interp *interp, /* Interpreter for error reporting; can be
- * NULL. */
- const char *fileName, /* Name of file to open. */
- const 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? */
-{
- const char *expectname = "testOpenFileChannel1%.fil";
- Tcl_DString ds;
-
- Tcl_DStringInit(&ds);
- Tcl_JoinPath(1, &expectname, &ds);
-
- if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
- Tcl_DStringFree(&ds);
- return (PretendTclpOpenFileChannel(interp,
- "__testOpenFileChannel1%__.fil",
- modeString, permissions));
- } else {
- Tcl_DStringFree(&ds);
- return NULL;
- }
-}
-
-static Tcl_Channel
-TestOpenFileChannelProc2(
- Tcl_Interp *interp, /* Interpreter for error reporting; can be
- * NULL. */
- const char *fileName, /* Name of file to open. */
- const 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? */
-{
- const char *expectname = "testOpenFileChannel2%.fil";
- Tcl_DString ds;
-
- Tcl_DStringInit(&ds);
- Tcl_JoinPath(1, &expectname, &ds);
-
- if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
- Tcl_DStringFree(&ds);
- return (PretendTclpOpenFileChannel(interp,
- "__testOpenFileChannel2%__.fil",
- modeString, permissions));
- } else {
- Tcl_DStringFree(&ds);
- return (NULL);
- }
-}
-
-static Tcl_Channel
-TestOpenFileChannelProc3(
- Tcl_Interp *interp, /* Interpreter for error reporting; can be
- * NULL. */
- const char *fileName, /* Name of file to open. */
- const 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? */
-{
- const char *expectname = "testOpenFileChannel3%.fil";
- Tcl_DString ds;
-
- Tcl_DStringInit(&ds);
- Tcl_JoinPath(1, &expectname, &ds);
-
- if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
- Tcl_DStringFree(&ds);
- return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel3%__.fil",
- modeString, permissions));
- } else {
- Tcl_DStringFree(&ds);
- return (NULL);
- }
-}
-#endif
/*
*----------------------------------------------------------------------
generated by cgit v0.12 at 2024-11-12 20:58:52 (GMT)