Attachment "577093.patch" to
ticket [577093ffff]
added by
dgp
2005-04-28 01:41:12.
Index: doc/open.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/open.n,v
retrieving revision 1.23
diff -u -r1.23 open.n
--- doc/open.n 6 Apr 2005 20:55:23 -0000 1.23
+++ doc/open.n 27 Apr 2005 18:07:45 -0000
@@ -61,6 +61,14 @@
Open the file for reading and writing. If the file doesn't exist,
create a new empty file.
Set the initial access position to the end of the file.
+.VS 8.5
+.PP
+All of the legal \fIaccess\fR values above may have the character
+\fBb\fR added as the second or third character in the value to
+indicate that the opened channel should be configured with the
+\fB-translation binary\fR option, making the channel suitable for
+reading or writing of binary data.
+.VE 8.5
.PP
In the second form, \fIaccess\fR consists of a list of any of the
following flags, all of which have the standard POSIX meanings.
@@ -78,6 +86,11 @@
\fBAPPEND\fR
Set the file pointer to the end of the file prior to each write.
.TP 15
+.VS 8.5
+\fBBINARY\fR
+Configure the opened channed with the \fB-translation binary\fR option.
+.VE 8.5
+.TP 15
\fBCREAT\fR
Create the file if it doesn't already exist (without this flag it
is an error for the file not to exist).
@@ -106,14 +119,6 @@
(an integer) is used to set the permissions for the new file in
conjunction with the process's file mode creation mask.
\fIPermissions\fR defaults to 0666.
-.PP
-Note that if you are going to be reading or writing binary data from
-the channel created by this command, you should use the
-\fBfconfigure\fR command to change the \fB-translation\fR option of
-the channel to \fBbinary\fR before transferring any binary data. This
-is in contrast to the ``b'' character passed as part of the equivalent
-of the \fIaccess\fR parameter to some versions of the C library
-\fIfopen()\fR function.
.SH "COMMAND PIPELINES"
.PP
Index: generic/tclIOCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOCmd.c,v
retrieving revision 1.22
diff -u -r1.22 tclIOCmd.c
--- generic/tclIOCmd.c 7 Oct 2004 00:24:49 -0000 1.22
+++ generic/tclIOCmd.c 27 Apr 2005 18:07:45 -0000
@@ -960,14 +960,14 @@
if (!pipeline) {
chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot);
} else {
- int mode, seekFlag, cmdObjc;
+ int mode, seekFlag, cmdObjc, binary;
CONST char **cmdArgv;
if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) {
return TCL_ERROR;
}
- mode = TclGetOpenMode(interp, modeString, &seekFlag);
+ mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
if (mode == -1) {
chan = NULL;
} else {
@@ -987,6 +987,9 @@
break;
}
chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags);
+ if (binary) {
+ Tcl_SetChannelOption(interp, chan, "-translation", "binary");
+ }
}
ckfree((char *) cmdArgv);
}
Index: generic/tclIOUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOUtil.c,v
retrieving revision 1.116
diff -u -r1.116 tclIOUtil.c
--- generic/tclIOUtil.c 16 Apr 2005 08:04:56 -0000 1.116
+++ generic/tclIOUtil.c 27 Apr 2005 18:07:46 -0000
@@ -1412,9 +1412,43 @@
* TclGetOpenMode --
*
* Description:
+ * This routine is an obsolete, limited version of
+ * TclGetOpenModeEx() below. It exists only to satisfy any
+ * extensions imprudently using it via Tcl's internal stubs table.
+ *
+ * Results:
+ * Same as TclGetOpenModeEx().
+ *
+ * Side effects:
+ * Same as TclGetOpenModeEx().
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclGetOpenMode(interp, modeString, seekFlagPtr)
+ Tcl_Interp *interp; /* Interpreter to use for error
+ * reporting - may be NULL. */
+ CONST char *modeString; /* Mode string, e.g. "r+" or
+ * "RDONLY CREAT". */
+ int *seekFlagPtr; /* Set this to 1 if the caller
+ * should seek to EOF during the
+ * opening of the file. */
+{
+ int binary = 0;
+ return TclGetOpenModeEx(interp, modeString, seekFlagPtr, &binary);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclGetOpenModeEx --
+ *
+ * Description:
* Computes a POSIX mode mask for opening a file, from a given string,
- * and also sets a flag to indicate whether the caller should seek to
- * EOF after opening the file.
+ * and also sets flags to indicate whether the caller should seek to
+ * EOF after opening the file, and whether the caller should
+ * configure the channel for binary data.
*
* Results:
* On success, returns mode to pass to "open". If an error occurs, the
@@ -1423,7 +1457,9 @@
*
* Side effects:
* Sets the integer referenced by seekFlagPtr to 1 to tell the caller
- * to seek to EOF after opening the file.
+ * to seek to EOF after opening the file, or to 0 otherwise. Sets the
+ * integer referenced by binaryPtr to 1 to tell the caller to seek to
+ * configure the channel for binary data, or to 0 otherwise.
*
* Special note:
* This code is based on a prototype implementation contributed
@@ -1431,16 +1467,18 @@
*
*---------------------------------------------------------------------------
*/
-
int
-TclGetOpenMode(interp, string, seekFlagPtr)
+TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
Tcl_Interp *interp; /* Interpreter to use for error
* reporting - may be NULL. */
- CONST char *string; /* Mode string, e.g. "r+" or
+ CONST char *modeString; /* Mode string, e.g. "r+" or
* "RDONLY CREAT". */
int *seekFlagPtr; /* Set this to 1 if the caller
* should seek to EOF during the
* opening of the file. */
+ int *binaryPtr; /* Set this to 1 if the caller
+ * should configure the opened
+ * channel for binary operations */
{
int mode, modeArgc, c, i, gotRW;
CONST char **modeArgv, *flag;
@@ -1453,6 +1491,7 @@
*/
*seekFlagPtr = 0;
+ *binaryPtr = 0;
mode = 0;
/*
@@ -1460,9 +1499,9 @@
* routines.
*/
- if (!(string[0] & 0x80)
- && islower(UCHAR(string[0]))) { /* INTL: ISO only. */
- switch (string[0]) {
+ if (!(modeString[0] & 0x80)
+ && islower(UCHAR(modeString[0]))) { /* INTL: ISO only. */
+ switch (modeString[0]) {
case 'r':
mode = O_RDONLY;
break;
@@ -1475,20 +1514,33 @@
break;
default:
error:
+ *seekFlagPtr = 0;
+ *binaryPtr = 0;
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp,
- "illegal access mode \"", string, "\"",
+ "illegal access mode \"", modeString, "\"",
(char *) NULL);
}
return -1;
}
- if (string[1] == '+') {
- mode &= ~(O_RDONLY|O_WRONLY);
- mode |= O_RDWR;
- if (string[2] != 0) {
+ i=1;
+ while (i<3 && modeString[i]) {
+ if (modeString[i] == modeString[i-1]) {
goto error;
}
- } else if (string[1] != 0) {
+ switch (modeString[i++]) {
+ case '+':
+ mode &= ~(O_RDONLY|O_WRONLY);
+ mode |= O_RDWR;
+ break;
+ case 'b':
+ *binaryPtr = 1;
+ break;
+ default:
+ goto error;
+ }
+ }
+ if (modeString[i] != 0) {
goto error;
}
return mode;
@@ -1502,11 +1554,11 @@
* a NULL interpreter is passed in.
*/
- if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) {
+ if (Tcl_SplitList(interp, modeString, &modeArgc, &modeArgv) != TCL_OK) {
if (interp != (Tcl_Interp *) NULL) {
Tcl_AddErrorInfo(interp,
"\n while processing open access modes \"");
- Tcl_AddErrorInfo(interp, string);
+ Tcl_AddErrorInfo(interp, modeString);
Tcl_AddErrorInfo(interp, "\"");
}
return -1;
@@ -1560,11 +1612,14 @@
#endif
} else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
mode |= O_TRUNC;
+ } else if ((c == 'B') && (strcmp(flag, "BINARY") == 0)) {
+ *binaryPtr = 1;
} else {
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp, "invalid access mode \"", flag,
- "\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT",
- " EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL);
+ "\": must be RDONLY, WRONLY, RDWR, APPEND, BINARY, "
+ "CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC",
+ (char *) NULL);
}
ckfree((char *) modeArgv);
return -1;
@@ -2086,8 +2141,8 @@
if (fsPtr != NULL) {
Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc;
if (proc != NULL) {
- int mode, seekFlag;
- mode = TclGetOpenMode(interp, modeString, &seekFlag);
+ int mode, seekFlag, binary;
+ mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
if (mode == -1) {
return NULL;
}
@@ -2106,6 +2161,10 @@
return NULL;
}
}
+ if (binary) {
+ Tcl_SetChannelOption(interp, retVal,
+ "-translation", "binary");
+ }
}
return retVal;
}
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.225
diff -u -r1.225 tclInt.h
--- generic/tclInt.h 22 Apr 2005 15:46:57 -0000 1.225
+++ generic/tclInt.h 27 Apr 2005 18:07:46 -0000
@@ -1889,7 +1889,9 @@
MODULE_SCOPE int TclGetNamespaceFromObj _ANSI_ARGS_((
Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_Namespace **nsPtrPtr));
-
+MODULE_SCOPE int TclGetOpenModeEx _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char *modeString, int *seekFlagPtr,
+ int *binaryPtr));
MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue _ANSI_ARGS_ ((
ProcessGlobalValue *pgvPtr));
MODULE_SCOPE int TclGlob _ANSI_ARGS_((Tcl_Interp *interp,
Index: tests/ioCmd.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/ioCmd.test,v
retrieving revision 1.21
diff -u -r1.21 ioCmd.test
--- tests/ioCmd.test 23 Jun 2004 15:36:57 -0000 1.21
+++ tests/ioCmd.test 27 Apr 2005 18:07:48 -0000
@@ -426,11 +426,36 @@
\"open \$path(test3) \"FOO \\{BAR BAZ\"\""
test iocmd-12.7 {POSIX open access modes: errors} {
list [catch {open $path(test3) {FOO BAR BAZ}} msg] $msg
-} {1 {invalid access mode "FOO": must be RDONLY, WRONLY, RDWR, APPEND, CREAT EXCL, NOCTTY, NONBLOCK, or TRUNC}}
+} {1 {invalid access mode "FOO": must be RDONLY, WRONLY, RDWR, APPEND, BINARY, CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC}}
test iocmd-12.8 {POSIX open access modes: errors} {
list [catch {open $path(test3) {TRUNC CREAT}} msg] $msg
} {1 {access mode must include either RDONLY, WRONLY, or RDWR}}
close [open $path(test3) w]
+test iocmd-12.9 {POSIX open access modes: BINARY} {
+ list [catch {open $path(test1) BINARY} msg] $msg
+} {1 {access mode must include either RDONLY, WRONLY, or RDWR}}
+test iocmd-12.10 {POSIX open access modes: BINARY} {
+ set f [open $path(test1) {WRONLY BINARY TRUNC}]
+ puts $f a
+ puts $f b
+ puts -nonewline $f c ;# contents are now 5 bytes: a\nb\nc
+ close $f
+ set f [open $path(test1) r]
+ fconfigure $f -translation binary
+ set result [string length [read $f]]
+ close $f
+ set result
+} 5
+test iocmd-12.11 {POSIX open access modes: BINARY} {
+ set f [open $path(test1) {WRONLY BINARY TRUNC}]
+ puts $f \u0248 ;# gets truncated to \u0048
+ close $f
+ set f [open $path(test1) r]
+ fconfigure $f -translation binary
+ set result [read -nonewline $f]
+ close $f
+ set result
+} \u0048
test iocmd-13.1 {errors in open command} {
list [catch {open} msg] $msg
@@ -452,6 +477,15 @@
regsub [file join {} _non_existent_] $msg "_non_existent_" msg
string tolower $msg
} {1 {couldn't open "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}}
+test iocmd-13.7 {errors in open command} {
+ list [catch {open $path(test1) b} msg] $msg
+} {1 {illegal access mode "b"}}
+test iocmd-13.8 {errors in open command} {
+ list [catch {open $path(test1) rbb} msg] $msg
+} {1 {illegal access mode "rbb"}}
+test iocmd-13.9 {errors in open command} {
+ list [catch {open $path(test1) r++} msg] $msg
+} {1 {illegal access mode "r++"}}
test iocmd-14.1 {file id parsing errors} {
list [catch {eof gorp} msg] $msg $errorCode
