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.

4 files changed, 61 insertions, 6 deletions

diff --git a/ChangeLog b/ChangeLog
index edf5679..e6b4189 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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} {