diff options
Diffstat (limited to 'generic/tclTest.c')
| -rw-r--r-- | generic/tclTest.c | 536 |
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 /* *---------------------------------------------------------------------- |