diff options
author | dgp <dgp@users.sourceforge.net> | 2008-04-21 16:26:36 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2008-04-21 16:26:36 (GMT) |
commit | 7346f5c47fd9b46f12a26714b5dde16148a5b932 (patch) | |
tree | 43966b029920f95f258773685998205a58dff5ef /generic | |
parent | 1829cc0665068c6129b9bd0bfbc1f7a3b53c1ab0 (diff) | |
download | tcl-7346f5c47fd9b46f12a26714b5dde16148a5b932.zip tcl-7346f5c47fd9b46f12a26714b5dde16148a5b932.tar.gz tcl-7346f5c47fd9b46f12a26714b5dde16148a5b932.tar.bz2 |
* generic/tclIOUtil.c: Removed all code delimited by
* generic/tclTest.c: USE_OBSOLETE_FS_HOOKS, completing
* tests/ioCmd.test: the deprecation path for these
* tests/ioUtil.test (removed): obsolete interfaces. (Code was active
in Tcl 8.4, present but enabled only by customized compile switch in
Tcl 8.5, and now completely gone for Tcl 8.6). Also removed all tests
relevant only to the removed interfaces.
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclIOUtil.c | 492 | ||||
-rw-r--r-- | generic/tclTest.c | 536 |
2 files changed, 2 insertions, 1026 deletions
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 745ba6b..778eaa6 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOUtil.c,v 1.151 2008/02/27 03:35:49 jenglish Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.152 2008/04/21 16:26:37 dgp Exp $ */ #include "tclInt.h" @@ -245,56 +245,7 @@ Tcl_EvalFile( * support, I suggest all these hooks are removed. */ -#undef USE_OBSOLETE_FS_HOOKS -#ifdef USE_OBSOLETE_FS_HOOKS - -/* - * The following typedef declarations allow for hooking into the chain of - * functions maintained for 'Tcl_Stat(...)', 'Tcl_Access(...)' & - * 'Tcl_OpenFileChannel(...)'. Basically for each hookable function a linked - * list is defined. - */ - -typedef struct StatProc { - TclStatProc_ *proc; /* Function to process a 'stat()' call */ - struct StatProc *nextPtr; /* The next 'stat()' function to call */ -} StatProc; - -typedef struct AccessProc { - TclAccessProc_ *proc; /* Function to process a 'access()' call */ - struct AccessProc *nextPtr; /* The next 'access()' function to call */ -} AccessProc; - -typedef struct OpenFileChannelProc { - TclOpenFileChannelProc_ *proc; - /* Function to process a - * 'Tcl_OpenFileChannel()' call */ - struct OpenFileChannelProc *nextPtr; - /* The next 'Tcl_OpenFileChannel()' function - * to call */ -} OpenFileChannelProc; - -/* - * For each type of (obsolete) hookable function, a static node is declared to - * hold the function pointer for the "built-in" routine (e.g. 'TclpStat(...)') - * and the respective list is initialized as a pointer to that node. - * - * The "delete" functions (e.g. 'TclStatDeleteProc(...)') ensure that these - * statically declared list entry cannot be inadvertently removed. - * - * This method avoids the need to call any sort of "initialization" function. - * - * All three lists are protected by a global obsoleteFsHookMutex. - */ - -static StatProc *statProcList = NULL; -static AccessProc *accessProcList = NULL; -static OpenFileChannelProc *openFileChannelProcList = NULL; - -TCL_DECLARE_MUTEX(obsoleteFsHookMutex) - -#endif /* USE_OBSOLETE_FS_HOOKS */ /* * Declare the native filesystem support. These functions should be considered @@ -814,11 +765,6 @@ TclFinalizeFilesystem(void) * filesystem is likely to fail. */ -#ifdef USE_OBSOLETE_FS_HOOKS - statProcList = NULL; - accessProcList = NULL; - openFileChannelProcList = NULL; -#endif #ifdef __WIN32__ TclWinEncodingsCleanup(); #endif @@ -1959,62 +1905,6 @@ Tcl_FSStat( Tcl_StatBuf *buf) /* Filled with results of stat call. */ { const Tcl_Filesystem *fsPtr; -#ifdef USE_OBSOLETE_FS_HOOKS - struct stat oldStyleStatBuffer; - int retVal = -1; - - /* - * Call each of the "stat" function in succession. A non-return value of - * -1 indicates the particular function has succeeded. - */ - - Tcl_MutexLock(&obsoleteFsHookMutex); - - if (statProcList != NULL) { - StatProc *statProcPtr; - char *path; - Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); - if (transPtr == NULL) { - path = NULL; - } else { - path = Tcl_GetString(transPtr); - } - - statProcPtr = statProcList; - while ((retVal == -1) && (statProcPtr != NULL)) { - retVal = (*statProcPtr->proc)(path, &oldStyleStatBuffer); - statProcPtr = statProcPtr->nextPtr; - } - if (transPtr != NULL) { - Tcl_DecrRefCount(transPtr); - } - } - - Tcl_MutexUnlock(&obsoleteFsHookMutex); - if (retVal != -1) { - /* - * Note that EOVERFLOW is not a problem here, and these assignments - * should all be widening (if not identity.) - */ - - buf->st_mode = oldStyleStatBuffer.st_mode; - buf->st_ino = oldStyleStatBuffer.st_ino; - buf->st_dev = oldStyleStatBuffer.st_dev; - buf->st_rdev = oldStyleStatBuffer.st_rdev; - buf->st_nlink = oldStyleStatBuffer.st_nlink; - buf->st_uid = oldStyleStatBuffer.st_uid; - buf->st_gid = oldStyleStatBuffer.st_gid; - buf->st_size = Tcl_LongAsWide(oldStyleStatBuffer.st_size); - buf->st_atime = oldStyleStatBuffer.st_atime; - buf->st_mtime = oldStyleStatBuffer.st_mtime; - buf->st_ctime = oldStyleStatBuffer.st_ctime; -#ifdef HAVE_ST_BLOCKS - buf->st_blksize = oldStyleStatBuffer.st_blksize; - buf->st_blocks = Tcl_LongAsWide(oldStyleStatBuffer.st_blocks); -#endif - return retVal; - } -#endif /* USE_OBSOLETE_FS_HOOKS */ fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL) { @@ -2090,41 +1980,6 @@ Tcl_FSAccess( int mode) /* Permission setting. */ { const Tcl_Filesystem *fsPtr; -#ifdef USE_OBSOLETE_FS_HOOKS - int retVal = -1; - - /* - * Call each of the "access" function in succession. A non-return value of - * -1 indicates the particular function has succeeded. - */ - - Tcl_MutexLock(&obsoleteFsHookMutex); - - if (accessProcList != NULL) { - AccessProc *accessProcPtr; - char *path; - Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); - if (transPtr == NULL) { - path = NULL; - } else { - path = Tcl_GetString(transPtr); - } - - accessProcPtr = accessProcList; - while ((retVal == -1) && (accessProcPtr != NULL)) { - retVal = (*accessProcPtr->proc)(path, mode); - accessProcPtr = accessProcPtr->nextPtr; - } - if (transPtr != NULL) { - Tcl_DecrRefCount(transPtr); - } - } - - Tcl_MutexUnlock(&obsoleteFsHookMutex); - if (retVal != -1) { - return retVal; - } -#endif /* USE_OBSOLETE_FS_HOOKS */ fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL) { @@ -2169,40 +2024,6 @@ Tcl_FSOpenFileChannel( const Tcl_Filesystem *fsPtr; Tcl_Channel retVal = NULL; -#ifdef USE_OBSOLETE_FS_HOOKS - /* - * Call each of the "Tcl_OpenFileChannel" functions in succession. A - * non-NULL return value indicates the particular function has succeeded. - */ - - Tcl_MutexLock(&obsoleteFsHookMutex); - if (openFileChannelProcList != NULL) { - OpenFileChannelProc *openFileChannelProcPtr; - char *path; - Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); - - if (transPtr == NULL) { - path = NULL; - } else { - path = Tcl_GetString(transPtr); - } - - openFileChannelProcPtr = openFileChannelProcList; - - while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) { - retVal = (*openFileChannelProcPtr->proc)(interp, path, - modeString, permissions); - openFileChannelProcPtr = openFileChannelProcPtr->nextPtr; - } - if (transPtr != NULL) { - Tcl_DecrRefCount(transPtr); - } - } - Tcl_MutexUnlock(&obsoleteFsHookMutex); - if (retVal != NULL) { - return retVal; - } -#endif /* USE_OBSOLETE_FS_HOOKS */ /* * We need this just to ensure we return the correct error messages under @@ -4623,317 +4444,6 @@ NativeFilesystemSeparator( return Tcl_NewStringObj(separator,1); } -/* Everything from here on is contained in this obsolete ifdef */ -#ifdef USE_OBSOLETE_FS_HOOKS - -/* - *---------------------------------------------------------------------- - * - * TclStatInsertProc -- - * - * Insert the passed function pointer at the head of the list of - * functions which are used during a call to 'TclStat(...)'. The passed - * function should behave exactly like 'TclStat' when called during that - * time (see 'TclStat(...)' for more information). The function will be - * added even if it already in the list. - * - * Results: - * Normally TCL_OK; TCL_ERROR if memory for a new node in the list could - * not be allocated. - * - * Side effects: - * Memory allocated and modifies the link list for 'TclStat' functions. - * - *---------------------------------------------------------------------- - */ - -int -TclStatInsertProc( - TclStatProc_ *proc) -{ - int retVal = TCL_ERROR; - - if (proc != NULL) { - StatProc *newStatProcPtr; - - newStatProcPtr = (StatProc *)ckalloc(sizeof(StatProc)); - - if (newStatProcPtr != NULL) { - newStatProcPtr->proc = proc; - Tcl_MutexLock(&obsoleteFsHookMutex); - newStatProcPtr->nextPtr = statProcList; - statProcList = newStatProcPtr; - Tcl_MutexUnlock(&obsoleteFsHookMutex); - - retVal = TCL_OK; - } - } - - return retVal; -} - -/* - *---------------------------------------------------------------------- - * - * TclStatDeleteProc -- - * - * Removed the passed function pointer from the list of 'TclStat' - * functions. Ensures that the built-in stat function is not removable. - * - * Results: - * TCL_OK if the function pointer was successfully removed, TCL_ERROR - * otherwise. - * - * Side effects: - * Memory is deallocated and the respective list updated. - * - *---------------------------------------------------------------------- - */ - -int -TclStatDeleteProc( - TclStatProc_ *proc) -{ - int retVal = TCL_ERROR; - StatProc *tmpStatProcPtr; - StatProc *prevStatProcPtr = NULL; - - Tcl_MutexLock(&obsoleteFsHookMutex); - tmpStatProcPtr = statProcList; - - /* - * Traverse the 'statProcList' looking for the particular node whose - * 'proc' member matches 'proc' and remove that one from the list. Ensure - * that the "default" node cannot be removed. - */ - - while ((retVal == TCL_ERROR) && (tmpStatProcPtr != NULL)) { - if (tmpStatProcPtr->proc == proc) { - if (prevStatProcPtr == NULL) { - statProcList = tmpStatProcPtr->nextPtr; - } else { - prevStatProcPtr->nextPtr = tmpStatProcPtr->nextPtr; - } - - ckfree((char *)tmpStatProcPtr); - - retVal = TCL_OK; - } else { - prevStatProcPtr = tmpStatProcPtr; - tmpStatProcPtr = tmpStatProcPtr->nextPtr; - } - } - - Tcl_MutexUnlock(&obsoleteFsHookMutex); - - return retVal; -} - -/* - *---------------------------------------------------------------------- - * - * TclAccessInsertProc -- - * - * Insert the passed function pointer at the head of the list of - * functions which are used during a call to 'TclAccess(...)'. The passed - * function should behave exactly like 'TclAccess' when called during - * that time (see 'TclAccess(...)' for more information). The function - * will be added even if it already in the list. - * - * Results: - * Normally TCL_OK; TCL_ERROR if memory for a new node in the list could - * not be allocated. - * - * Side effects: - * Memory allocated and modifies the link list for 'TclAccess' functions. - * - *---------------------------------------------------------------------- - */ - -int -TclAccessInsertProc( - TclAccessProc_ *proc) -{ - int retVal = TCL_ERROR; - - if (proc != NULL) { - AccessProc *newAccessProcPtr; - - newAccessProcPtr = (AccessProc *)ckalloc(sizeof(AccessProc)); - - if (newAccessProcPtr != NULL) { - newAccessProcPtr->proc = proc; - Tcl_MutexLock(&obsoleteFsHookMutex); - newAccessProcPtr->nextPtr = accessProcList; - accessProcList = newAccessProcPtr; - Tcl_MutexUnlock(&obsoleteFsHookMutex); - - retVal = TCL_OK; - } - } - - return retVal; -} - -/* - *---------------------------------------------------------------------- - * - * TclAccessDeleteProc -- - * - * Removed the passed function pointer from the list of 'TclAccess' - * functions. Ensures that the built-in access function is not removable. - * - * Results: - * TCL_OK if the function pointer was successfully removed, TCL_ERROR - * otherwise. - * - * Side effects: - * Memory is deallocated and the respective list updated. - * - *---------------------------------------------------------------------- - */ - -int -TclAccessDeleteProc( - TclAccessProc_ *proc) -{ - int retVal = TCL_ERROR; - AccessProc *tmpAccessProcPtr; - AccessProc *prevAccessProcPtr = NULL; - - /* - * Traverse the 'accessProcList' looking for the particular node whose - * 'proc' member matches 'proc' and remove that one from the list. Ensure - * that the "default" node cannot be removed. - */ - - Tcl_MutexLock(&obsoleteFsHookMutex); - tmpAccessProcPtr = accessProcList; - while ((retVal == TCL_ERROR) && (tmpAccessProcPtr != NULL)) { - if (tmpAccessProcPtr->proc == proc) { - if (prevAccessProcPtr == NULL) { - accessProcList = tmpAccessProcPtr->nextPtr; - } else { - prevAccessProcPtr->nextPtr = tmpAccessProcPtr->nextPtr; - } - - ckfree((char *)tmpAccessProcPtr); - - retVal = TCL_OK; - } else { - prevAccessProcPtr = tmpAccessProcPtr; - tmpAccessProcPtr = tmpAccessProcPtr->nextPtr; - } - } - Tcl_MutexUnlock(&obsoleteFsHookMutex); - - return retVal; -} - -/* - *---------------------------------------------------------------------- - * - * TclOpenFileChannelInsertProc -- - * - * Insert the passed function pointer at the head of the list of - * functions which are used during a call to 'Tcl_OpenFileChannel(...)'. - * The passed function should behave exactly like 'Tcl_OpenFileChannel' - * when called during that time (see 'Tcl_OpenFileChannel(...)' for more - * information). The function will be added even if it already in the - * list. - * - * Results: - * Normally TCL_OK; TCL_ERROR if memory for a new node in the list could - * not be allocated. - * - * Side effects: - * Memory allocated and modifies the link list for 'Tcl_OpenFileChannel' - * functions. - * - *---------------------------------------------------------------------- - */ - -int -TclOpenFileChannelInsertProc( - TclOpenFileChannelProc_ *proc) -{ - int retVal = TCL_ERROR; - - if (proc != NULL) { - OpenFileChannelProc *newOpenFileChannelProcPtr; - - newOpenFileChannelProcPtr = (OpenFileChannelProc *) - ckalloc(sizeof(OpenFileChannelProc)); - - newOpenFileChannelProcPtr->proc = proc; - Tcl_MutexLock(&obsoleteFsHookMutex); - newOpenFileChannelProcPtr->nextPtr = openFileChannelProcList; - openFileChannelProcList = newOpenFileChannelProcPtr; - Tcl_MutexUnlock(&obsoleteFsHookMutex); - - retVal = TCL_OK; - } - - return retVal; -} - -/* - *---------------------------------------------------------------------- - * - * TclOpenFileChannelDeleteProc -- - * - * Removed the passed function pointer from the list of - * 'Tcl_OpenFileChannel' functions. Ensures that the built-in open file - * channel function is not removable. - * - * Results: - * TCL_OK if the function pointer was successfully removed, TCL_ERROR - * otherwise. - * - * Side effects: - * Memory is deallocated and the respective list updated. - * - *---------------------------------------------------------------------- - */ - -int -TclOpenFileChannelDeleteProc( - TclOpenFileChannelProc_ *proc) -{ - int retVal = TCL_ERROR; - OpenFileChannelProc *tmpOpenFileChannelProcPtr = openFileChannelProcList; - OpenFileChannelProc *prevOpenFileChannelProcPtr = NULL; - - /* - * Traverse the 'openFileChannelProcList' looking for the particular node - * whose 'proc' member matches 'proc' and remove that one from the list. - */ - - Tcl_MutexLock(&obsoleteFsHookMutex); - tmpOpenFileChannelProcPtr = openFileChannelProcList; - while ((retVal == TCL_ERROR) && - (tmpOpenFileChannelProcPtr != NULL)) { - if (tmpOpenFileChannelProcPtr->proc == proc) { - if (prevOpenFileChannelProcPtr == NULL) { - openFileChannelProcList = tmpOpenFileChannelProcPtr->nextPtr; - } else { - prevOpenFileChannelProcPtr->nextPtr = - tmpOpenFileChannelProcPtr->nextPtr; - } - - ckfree((char *) tmpOpenFileChannelProcPtr); - - retVal = TCL_OK; - } else { - prevOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr; - tmpOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr->nextPtr; - } - } - Tcl_MutexUnlock(&obsoleteFsHookMutex); - - return retVal; -} -#endif /* USE_OBSOLETE_FS_HOOKS */ /* * Local Variables: 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 /* *---------------------------------------------------------------------- |