diff options
| -rw-r--r-- | ChangeLog | 16 | ||||
| -rw-r--r-- | generic/tclIO.c | 14 | ||||
| -rw-r--r-- | tests/io.test | 33 | ||||
| -rw-r--r-- | tests/socket.test | 4 |
4 files changed, 61 insertions, 6 deletions
@@ -1,3 +1,19 @@ +2002-01-25 Mo DeJong <mdejong@users.sourceforge.net> + + Make -eofchar and -translation options read only for + server sockets. [Bug 496733] + + * generic/tclIO.c (Tcl_GetChannelOption, Tcl_SetChannelOption): + Instead of returning nothing for the -translation option + on a server socket, always return "auto". Return the empty + string enclosed in quotes for the -eofchar option on + a server socket. Fixup -eofchar usage message so that + it matches the implementation. + * tests/io.test: Add -eofchar tests and -translation tests + to ensure options are read only on server sockets. + * tests/socket.test: Update tests to account for -eofchar + and -translation option changes. + 2002-01-25 Don Porter <dgp@users.sourceforge.net> * Following is [Patch 501006] diff --git a/generic/tclIO.c b/generic/tclIO.c index 12df2a6..75f6d42 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIO.c,v 1.49 2002/01/25 20:40:55 dgp Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.50 2002/01/25 23:06:58 mdejong Exp $ */ #include "tclInt.h" @@ -6096,6 +6096,10 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr) Tcl_DStringAppendElement(dsPtr, buf); } } + if ( !(flags & (TCL_READABLE|TCL_WRITABLE))) { + /* Not readable or writable (server socket) */ + Tcl_DStringAppendElement(dsPtr, ""); + } if (((flags & (TCL_READABLE|TCL_WRITABLE)) == (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) { Tcl_DStringEndSublist(dsPtr); @@ -6136,6 +6140,10 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr) Tcl_DStringAppendElement(dsPtr, "lf"); } } + if ( !(flags & (TCL_READABLE|TCL_WRITABLE))) { + /* Not readable or writable (server socket) */ + Tcl_DStringAppendElement(dsPtr, "auto"); + } if (((flags & (TCL_READABLE|TCL_WRITABLE)) == (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) { Tcl_DStringEndSublist(dsPtr); @@ -6305,8 +6313,8 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue) } else if (argc != 2) { if (interp) { Tcl_AppendResult(interp, - "bad value for -eofchar: should be a list of one or", - " two elements", (char *) NULL); + "bad value for -eofchar: should be a list of zero,", + " one, or two elements", (char *) NULL); } ckfree((char *) argv); return TCL_ERROR; diff --git a/tests/io.test b/tests/io.test index 62cee1f..148bdd5 100644 --- a/tests/io.test +++ b/tests/io.test @@ -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: io.test,v 1.23 2002/01/21 20:38:06 andreas_kupries Exp $ +# RCS: @(#) $Id: io.test,v 1.24 2002/01/25 23:06:58 mdejong Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -5028,6 +5028,37 @@ test io-39.21 {Tcl_SetChannelOption, setting read mode independently} \ close $s2 set modes } {auto crlf} +test io-39.22 {Tcl_SetChannelOption, invariance} { + removeFile test1 + set f1 [open test1 w+] + set l "" + lappend l [fconfigure $f1 -eofchar] + fconfigure $f1 -eofchar {ON GO} + lappend l [fconfigure $f1 -eofchar] + fconfigure $f1 -eofchar D + lappend l [fconfigure $f1 -eofchar] + lappend l [list [catch {fconfigure $f1 -eofchar {1 2 3}} msg] $msg] + close $f1 + set l +} {{{} {}} {O G} {D D}\ +{1 {bad value for -eofchar: should be a list of zero, one, or two elements}}} +test io-39.23 {Tcl_GetChannelOption, server socket is not readable or + writeable, it should still have valid -eofchar and -translation options } { + set l [list] + set sock [socket -server accept 0] + lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation] + close $sock + set l +} {{{}} auto} +test io-39.24 {Tcl_SetChannelOption, server socket is not readable or + writable so we can't change -eofchar or -translation } { + set l [list] + set sock [socket -server accept 0] + fconfigure $sock -eofchar D -translation lf + lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation] + close $sock + set l +} {{{}} auto} test io-40.1 {POSIX open access modes: RDWR} { removeFile test3 diff --git a/tests/socket.test b/tests/socket.test index 80b8298..cca7abb 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: socket.test,v 1.20 2001/10/12 19:45:08 hobbs Exp $ +# RCS: @(#) $Id: socket.test,v 1.21 2002/01/25 23:06:58 mdejong Exp $ # Running socket tests with a remote server: # ------------------------------------------ @@ -847,7 +847,7 @@ test socket-7.3 {testing socket specific options} {socket} { close $s update llength $l -} 12 +} 14 test socket-7.4 {testing socket specific options} {socket} { set s [socket -server accept 0] proc accept {s a p} { |