From 784535a35c779f46886fe9a880b706c979efdd77 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Thu, 30 Mar 2023 08:46:27 +0000
Subject: Allow empty mode list in [chan create], so that refchans are able to
 mimic the behavior of channels created by [socket -server].

---
 doc/refchan.n        |  4 ++--
 generic/tclIORChan.c | 21 ++++++++++-----------
 tests/ioCmd.test     | 10 +++++-----
 3 files changed, 17 insertions(+), 18 deletions(-)

diff --git a/doc/refchan.n b/doc/refchan.n
index 8737556..1e7e733 100644
--- a/doc/refchan.n
+++ b/doc/refchan.n
@@ -53,8 +53,8 @@ here, then the \fBfinalize\fR subcommand will not be called.
 .PP
 The \fImode\fR argument tells the handler whether the channel was
 opened for reading, writing, or both. It is a list containing any of
-the strings \fBread\fR or \fBwrite\fR. The list will always
-contain at least one element.
+the strings \fBread\fR or \fBwrite\fR. The list may be empty, but
+will usually contain at least one element. 
 .PP
 The subcommand must throw an error if the chosen mode is not
 supported by the \fIcmdPrefix\fR.
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 8c6f25f..482b0d5 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -532,7 +532,7 @@ TclChanCreateObjCmd(
 
     /*
      * First argument is a list of modes. Allowed entries are "read", "write".
-     * Expect at least one list element. Abbreviations are ok.
+     * Empty list is uncommon, but allowed. Abbreviations are ok.
      */
 
     modeObj = objv[MODE];
@@ -905,6 +905,11 @@ TclChanPostEventObjCmd(
     if (EncodeEventMask(interp, "event", objv[EVENT], &events) != TCL_OK) {
 	return TCL_ERROR;
     }
+    if (events == 0) {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("bad event list: is empty", -1));
+	return TCL_ERROR;
+    }
 
     /*
      * Check that the channel is actually interested in the provided events.
@@ -2007,10 +2012,10 @@ ReflectGetOption(
  * EncodeEventMask --
  *
  *	This function takes a list of event items and constructs the
- *	equivalent internal bitmask. The list must contain at least one
- *	element. Elements are "read", "write", or any unique abbreviation of
- *	them. Note that the bitmask is not changed if problems are
- *	encountered.
+ *	equivalent internal bitmask. The list may be empty but will usually
+ *	contain at least one element. Valid elements are "read", "write", or
+ *	any unique abbreviation of them. Note that the bitmask is not changed
+ *	if problems are encountered.
  *
  * Results:
  *	A standard Tcl error code. A bitmask where TCL_READABLE and/or
@@ -2040,12 +2045,6 @@ EncodeEventMask(
 	return TCL_ERROR;
     }
 
-    if (listc < 1) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                "bad %s list: is empty", objName));
-	return TCL_ERROR;
-    }
-
     events = 0;
     while (listc > 0) {
 	if (Tcl_GetIndexFromObj(interp, listv[listc-1], eventOptions,
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index d17dce3..b0dd1d7 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -670,12 +670,12 @@ test iocmd-21.1 {chan create, wrong#args, too many} {
     catch {chan create a b c} msg
     set msg
 } {wrong # args: should be "chan create mode cmdprefix"}
-test iocmd-21.2 {chan create, invalid r/w mode, empty} {
-    proc foo {} {}
-    catch {chan create {} foo} msg
+test iocmd-21.2 {chan create, r/w mode empty} {
+    proc foo {cmd args} { return {initialize finalize watch} }
+    set chan [chan create {} foo]
+    close $chan
     rename foo {}
-    set msg
-} {bad mode list: is empty}
+} {}
 test iocmd-21.3 {chan create, invalid r/w mode, bad string} {
     proc foo {} {}
     catch {chan create {c} foo} msg
-- 
cgit v0.12