Attachment "tclch.patch" to
ticket [578607ffff]
added by
vincentdarley
2002-07-08 16:46:27.
? win/efile
? win/httpd
? win/outdata
Index: doc/FileSystem.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/FileSystem.3,v
retrieving revision 1.27
diff -b -u -r1.27 FileSystem.3
--- doc/FileSystem.3 1 Jul 2002 18:24:39 -0000 1.27
+++ doc/FileSystem.3 8 Jul 2002 09:41:18 -0000
@@ -432,10 +432,10 @@
the Unix standard I/O library.
The syntax and meaning of all arguments is similar to those
given in the Tcl \fBopen\fR command when opening a file.
-If an error occurs while opening the channel, \fBTcl_OpenFileChannel\fR
+If an error occurs while opening the channel, \fBTcl_FSOpenFileChannel\fR
returns NULL and records a POSIX error code that can be
retrieved with \fBTcl_GetErrno\fR.
-In addition, if \fIinterp\fR is non-NULL, \fBTcl_OpenFileChannel\fR
+In addition, if \fIinterp\fR is non-NULL, \fBTcl_FSOpenFileChannel\fR
leaves an error message in \fIinterp\fR's result after any error.
.PP
The newly created channel is not registered in the supplied interpreter; to
@@ -953,21 +953,22 @@
typedef Tcl_Channel Tcl_FSOpenFileChannelProc(
Tcl_Interp *\fIinterp\fR,
Tcl_Obj *\fIpathPtr\fR,
- CONST char *\fImodeString\fR,
+ int \fImode\fR,
int \fIpermissions\fR);
.CE
.PP
The \fBTcl_FSOpenFileChannelProc\fR opens a file specified by
\fIpathPtr\fR and returns a channel handle that can be used to perform
-input and output on the file. This API is modeled after the
-\fBfopen\fR procedure of the Unix standard I/O library. The syntax and
-meaning of all arguments is similar to those given in the Tcl
-\fBopen\fR command when opening a file. If an error occurs while
-opening the channel, the \fBTcl_FSOpenFileChannelProc\fR returns NULL
-and records a POSIX error code that can be retrieved with
-\fBTcl_GetErrno\fR. In addition, if \fIinterp\fR is non-NULL, the
-\fBTcl_FSOpenFileChannelProc\fR leaves an error message in
-\fIinterp\fR's result after any error.
+input and output on the file. This API is modeled after the \fBfopen\fR
+procedure of the Unix standard I/O library. The syntax and meaning of
+all arguments is similar to those given in the Tcl \fBopen\fR command
+when opening a file, where the \fImode\fR argument is a combination of
+the POSIX flags O_RDONLY, O_WRONLY, etc. If an error occurs while
+opening the channel, the \fBTcl_FSOpenFileChannelProc\fR returns NULL and
+records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR.
+In addition, if \fIinterp\fR is non-NULL, the
+\fBTcl_FSOpenFileChannelProc\fR leaves an error message in \fIinterp\fR's
+result after any error.
.PP
The newly created channel is not registered in the supplied
interpreter; to register it, use \fBTcl_RegisterChannel\fR. If one of
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.90
diff -b -u -r1.90 tcl.decls
--- generic/tcl.decls 21 Jun 2002 14:22:28 -0000 1.90
+++ generic/tcl.decls 8 Jul 2002 09:41:18 -0000
@@ -1611,7 +1611,7 @@
}
declare 456 generic {
Tcl_Channel Tcl_FSOpenFileChannel(Tcl_Interp *interp, Tcl_Obj *pathPtr,
- CONST char *modeString, int permissions)
+ CONST char* modeString, int permissions)
}
declare 457 generic {
Tcl_Obj* Tcl_FSGetCwd(Tcl_Interp *interp)
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.130
diff -b -u -r1.130 tcl.h
--- generic/tcl.h 21 Jun 2002 23:55:35 -0000 1.130
+++ generic/tcl.h 8 Jul 2002 09:41:19 -0000
@@ -1583,7 +1583,7 @@
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));
Index: generic/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.90
diff -b -u -r1.90 tclDecls.h
--- generic/tclDecls.h 22 Jun 2002 00:06:23 -0000 1.90
+++ generic/tclDecls.h 8 Jul 2002 09:41:20 -0000
@@ -1449,7 +1449,7 @@
/* 456 */
EXTERN Tcl_Channel Tcl_FSOpenFileChannel _ANSI_ARGS_((
Tcl_Interp * interp, Tcl_Obj * pathPtr,
- CONST char * modeString, int permissions));
+ CONST char* modeString, int permissions));
/* 457 */
EXTERN Tcl_Obj* Tcl_FSGetCwd _ANSI_ARGS_((Tcl_Interp * interp));
/* 458 */
@@ -2071,7 +2071,7 @@
CONST char ** (*tcl_FSFileAttrStrings) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_Obj ** objPtrRef)); /* 453 */
int (*tcl_FSStat) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_StatBuf * buf)); /* 454 */
int (*tcl_FSAccess) _ANSI_ARGS_((Tcl_Obj * pathPtr, int mode)); /* 455 */
- Tcl_Channel (*tcl_FSOpenFileChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr, CONST char * modeString, int permissions)); /* 456 */
+ Tcl_Channel (*tcl_FSOpenFileChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr, CONST char* modeString, int permissions)); /* 456 */
Tcl_Obj* (*tcl_FSGetCwd) _ANSI_ARGS_((Tcl_Interp * interp)); /* 457 */
int (*tcl_FSChdir) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 458 */
int (*tcl_FSConvertToPathType) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr)); /* 459 */
Index: generic/tclIOUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOUtil.c,v
retrieving revision 1.51
diff -b -u -r1.51 tclIOUtil.c
--- generic/tclIOUtil.c 26 Jun 2002 16:01:09 -0000 1.51
+++ generic/tclIOUtil.c 8 Jul 2002 09:41:21 -0000
@@ -1718,7 +1718,28 @@
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 */
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.95
diff -b -u -r1.95 tclInt.h
--- generic/tclInt.h 17 Jun 2002 22:52:51 -0000 1.95
+++ generic/tclInt.h 8 Jul 2002 09:41:22 -0000
@@ -1904,7 +1904,7 @@
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));
Index: generic/tclTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTest.c,v
retrieving revision 1.52
diff -b -u -r1.52 tclTest.c
--- generic/tclTest.c 1 Jul 2002 14:35:09 -0000 1.52
+++ generic/tclTest.c 8 Jul 2002 09:41:26 -0000
@@ -345,7 +345,7 @@
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 @@
* 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 @@
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
Index: mac/tclMacChan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacChan.c,v
retrieving revision 1.16
diff -b -u -r1.16 tclMacChan.c
--- mac/tclMacChan.c 5 Jun 2002 11:59:38 -0000 1.16
+++ mac/tclMacChan.c 8 Jul 2002 09:41:26 -0000
@@ -741,7 +741,7 @@
*
* TclpOpenFileChannel --
*
- * Open an File based channel on Unix systems.
+ * Open a File based channel on MacOS systems.
*
* Results:
* The new channel or NULL. If NULL, the output argument
@@ -759,22 +759,15 @@
Tcl_Interp *interp, /* Interpreter for error reporting;
* can be NULL. */
Tcl_Obj *pathPtr, /* 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? */
{
Tcl_Channel chan;
- int mode;
CONST char *native;
int errorCode;
- mode = GetOpenMode(interp, modeString);
- if (mode == -1) {
- return NULL;
- }
-
native = Tcl_FSGetNativePath(pathPtr);
if (native == NULL) {
return NULL;
Index: unix/tclUnixChan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixChan.c,v
retrieving revision 1.36
diff -b -u -r1.36 tclUnixChan.c
--- unix/tclUnixChan.c 28 Jun 2002 09:56:54 -0000 1.36
+++ unix/tclUnixChan.c 8 Jul 2002 09:41:27 -0000
@@ -1746,17 +1746,16 @@
*/
Tcl_Channel
-TclpOpenFileChannel(interp, pathPtr, modeString, permissions)
+TclpOpenFileChannel(interp, pathPtr, mode, permissions)
Tcl_Interp *interp; /* Interpreter for error reporting;
* can be NULL. */
Tcl_Obj *pathPtr; /* 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? */
{
- int fd, seekFlag, mode, channelPermissions;
+ int fd, channelPermissions;
FileState *fsPtr;
CONST char *native, *translation;
char channelName[16 + TCL_INTEGER_SPACE];
@@ -1768,10 +1767,6 @@
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
#endif /* DEPRECATED */
- mode = TclGetOpenMode(interp, modeString, &seekFlag);
- if (mode == -1) {
- return NULL;
- }
switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
case O_RDONLY:
channelPermissions = TCL_READABLE;
@@ -1847,18 +1842,6 @@
fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
(ClientData) fsPtr, channelPermissions);
-
- if (seekFlag) {
- if (Tcl_Seek(fsPtr->channel, (Tcl_WideInt)0,
- SEEK_END) < (Tcl_WideInt)0) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "couldn't seek to end of file on \"",
- channelName, "\": ", Tcl_PosixError(interp), NULL);
- }
- Tcl_Close(NULL, fsPtr->channel);
- return NULL;
- }
- }
if (translation != NULL) {
/*
Index: win/tclWinChan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinChan.c,v
retrieving revision 1.23
diff -b -u -r1.23 tclWinChan.c
--- win/tclWinChan.c 24 May 2002 21:19:09 -0000 1.23
+++ win/tclWinChan.c 8 Jul 2002 09:41:28 -0000
@@ -744,18 +744,17 @@
*/
Tcl_Channel
-TclpOpenFileChannel(interp, pathPtr, modeString, permissions)
+TclpOpenFileChannel(interp, pathPtr, mode, permissions)
Tcl_Interp *interp; /* Interpreter for error reporting;
* can be NULL. */
Tcl_Obj *pathPtr; /* Name of file to open. */
- CONST char *modeString; /* A list of POSIX open modes or
- * a string such as "rw". */
+ int mode; /* POSIX mode. */
int permissions; /* If the open involves creating a
* file, with what modes to create
* it? */
{
Tcl_Channel channel = 0;
- int seekFlag, mode, channelPermissions;
+ int channelPermissions;
DWORD accessMode, createMode, shareMode, flags, consoleParams, type;
CONST TCHAR *nativeName;
DCB dcb;
@@ -764,11 +763,6 @@
TclFile readFile = NULL;
TclFile writeFile = NULL;
- mode = TclGetOpenMode(interp, modeString, &seekFlag);
- if (mode == -1) {
- return NULL;
- }
-
nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr);
if (nativeName == NULL) {
return NULL;
@@ -937,20 +931,6 @@
break;
}
- if (channel != NULL) {
- if (seekFlag) {
- if (Tcl_Seek(channel, 0, SEEK_END) < 0) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp,
- "could not seek to end of file on \"",
- channelName, "\": ", Tcl_PosixError(interp),
- (char *) NULL);
- }
- Tcl_Close(NULL, channel);
- return NULL;
- }
- }
- }
return channel;
}
