diff options
author | vincentdarley <vincentdarley> | 2002-07-08 10:08:57 (GMT) |
---|---|---|
committer | vincentdarley <vincentdarley> | 2002-07-08 10:08:57 (GMT) |
commit | 6cf4fe89feaa9ef6da9ddded6f2199f76d00e73e (patch) | |
tree | 44cae45dd1f262fcc31e6d07b240050fb7e44481 /generic | |
parent | 11a54cb010fa27ab006f13181b40da00a4f87550 (diff) | |
download | tcl-6cf4fe89feaa9ef6da9ddded6f2199f76d00e73e.zip tcl-6cf4fe89feaa9ef6da9ddded6f2199f76d00e73e.tar.gz tcl-6cf4fe89feaa9ef6da9ddded6f2199f76d00e73e.tar.bz2 |
fs cleanup
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tcl.h | 4 | ||||
-rw-r--r-- | generic/tclIOUtil.c | 25 | ||||
-rw-r--r-- | generic/tclInt.h | 4 | ||||
-rw-r--r-- | generic/tclTest.c | 37 |
4 files changed, 55 insertions, 15 deletions
diff --git a/generic/tcl.h b/generic/tcl.h index 34a3311..893cddf 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.130 2002/06/21 23:55:35 dkf Exp $ + * RCS: @(#) $Id: tcl.h,v 1.131 2002/07/08 10:08:57 vincentdarley Exp $ */ #ifndef _TCL @@ -1583,7 +1583,7 @@ typedef int (Tcl_FSStatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf)); typedef int (Tcl_FSAccessProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, int mode)); typedef Tcl_Channel (Tcl_FSOpenFileChannelProc) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, - CONST84 char *modeString, int permissions)); + int mode, int permissions)); typedef int (Tcl_FSMatchInDirectoryProc) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *result, Tcl_Obj *pathPtr, CONST84 char *pattern, Tcl_GlobTypeData * types)); diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 7b8fdc9..37d9071 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.51 2002/06/26 16:01:09 vincentdarley Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.52 2002/07/08 10:08:57 vincentdarley Exp $ */ #include "tclInt.h" @@ -1718,7 +1718,28 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions) if (fsPtr != NULL) { Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc; if (proc != NULL) { - return (*proc)(interp, pathPtr, modeString, permissions); + int mode, seekFlag; + mode = TclGetOpenMode(interp, modeString, &seekFlag); + if (mode == -1) { + return NULL; + } + retVal = (*proc)(interp, pathPtr, mode, permissions); + if (retVal != NULL) { + if (seekFlag) { + if (Tcl_Seek(retVal, (Tcl_WideInt)0, + (Tcl_WideInt)SEEK_END) < (Tcl_WideInt)0) { + if (interp != (Tcl_Interp *) NULL) { + Tcl_AppendResult(interp, + "could not seek to end of file while opening \"", + Tcl_GetString(pathPtr), "\": ", + Tcl_PosixError(interp), (char *) NULL); + } + Tcl_Close(NULL, retVal); + return NULL; + } + } + } + return retVal; } } /* File doesn't belong to any filesystem that can open it */ diff --git a/generic/tclInt.h b/generic/tclInt.h index d16d02c..dc77293 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.95 2002/06/17 22:52:51 hobbs Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.96 2002/07/08 10:08:57 vincentdarley Exp $ */ #ifndef _TCLINT @@ -1904,7 +1904,7 @@ EXTERN Tcl_Obj* TclFileDirname _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj*pathPtr)); EXTERN int TclpObjStat _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf)); EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *pathPtr, CONST char *modeString, + Tcl_Obj *pathPtr, int mode, int permissions)); EXTERN void TclpPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *, format)); diff --git a/generic/tclTest.c b/generic/tclTest.c index ebcdc39..9f56bba 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -13,7 +13,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.52 2002/07/01 14:35:09 dgp Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.53 2002/07/08 10:08:58 vincentdarley Exp $ */ #define TCL_TEST @@ -345,7 +345,7 @@ static int TestReportAccess _ANSI_ARGS_ ((Tcl_Obj *path, int mode)); static Tcl_Channel TestReportOpenFileChannel _ANSI_ARGS_ (( Tcl_Interp *interp, Tcl_Obj *fileName, - CONST char *modeString, int permissions)); + int mode, int permissions)); static int TestReportMatchInDirectory _ANSI_ARGS_ (( Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *dirPtr, CONST char *pattern, @@ -4773,10 +4773,30 @@ PretendTclpOpenFileChannel(interp, fileName, modeString, permissions) * it? */ { Tcl_Channel ret; - Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName, -1); + 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, modeString, permissions); + ret = TclpOpenFileChannel(interp, pathPtr, mode, permissions); Tcl_DecrRefCount(pathPtr); + if (ret != NULL) { + if (seekFlag) { + if (Tcl_Seek(ret, 0, SEEK_END) < 0) { + if (interp != (Tcl_Interp *) NULL) { + Tcl_AppendResult(interp, + "could not seek to end of file while opening \"", + fileName, "\": ", + Tcl_PosixError(interp), (char *) NULL); + } + Tcl_Close(NULL, ret); + return NULL; + } + } + } return ret; } @@ -5772,19 +5792,18 @@ TestReportAccess(path, mode) return Tcl_FSAccess(TestReportGetNativePath(path),mode); } static Tcl_Channel -TestReportOpenFileChannel(interp, fileName, modeString, permissions) +TestReportOpenFileChannel(interp, fileName, mode, permissions) Tcl_Interp *interp; /* Interpreter for error reporting; * can be NULL. */ Tcl_Obj *fileName; /* Name of file to open. */ - CONST char *modeString; /* A list of POSIX open modes or - * a string such as "rw". */ + int mode; /* POSIX open mode. */ int permissions; /* If the open involves creating a * file, with what modes to create * it? */ { TestReport("open",fileName, NULL); - return Tcl_FSOpenFileChannel(interp, TestReportGetNativePath(fileName), - modeString, permissions); + return TclpOpenFileChannel(interp, TestReportGetNativePath(fileName), + mode, permissions); } static int |