merge trunk

5 files changed, 81 insertions, 30 deletions

diff --git a/unix/Makefile.in b/unix/Makefile.in
index f151ebb..5a2d9af 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -852,8 +852,8 @@ install-libraries: libraries
 	    done;
 	@echo "Installing package msgcat 1.5.2 as a Tcl Module";
 	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.5.2.tm;
-	@echo "Installing package tcltest 2.3.7 as a Tcl Module";
-	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.7.tm;
+	@echo "Installing package tcltest 2.3.8 as a Tcl Module";
+	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.8.tm;
 
 	@echo "Installing package platform 1.0.12 as a Tcl Module";
 	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.12.tm;
diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c
index a02044e..95bc8d1 100644
--- a/unix/tclUnixPipe.c
+++ b/unix/tclUnixPipe.c
@@ -229,7 +229,7 @@ TclpCreateTempFile(
 Tcl_Obj *
 TclpTempFileName(void)
 {
-    Tcl_Obj *nameObj = Tcl_NewObj();
+    Tcl_Obj *retVal, *nameObj = Tcl_NewObj();
     int fd;
 
     Tcl_IncrRefCount(nameObj);
@@ -242,7 +242,9 @@ TclpTempFileName(void)
     fcntl(fd, F_SETFD, FD_CLOEXEC);
     TclpObjDeleteFile(nameObj);
     close(fd);
-    return nameObj;
+    retVal = Tcl_DuplicateObj(nameObj);
+    Tcl_DecrRefCount(nameObj);
+    return retVal;
 }
 
 /*
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index fdd4287..0f700cf 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -57,6 +57,8 @@ struct TcpState {
     TcpFdList fds;		/* The file descriptors of the sockets. */
     int flags;			/* ORed combination of the bitfields defined
 				 * below. */
+    int interest;		/* Event types of interest */
+
     /*
      * Only needed for server sockets
      */
@@ -145,6 +147,7 @@ static int		TcpOutputProc(ClientData instanceData,
 			    const char *buf, int toWrite, int *errorCode);
 static void		TcpWatchProc(ClientData instanceData, int mask);
 static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr);
+static void		WrapNotify(ClientData clientData, int mask);
 
 /*
  * This structure describes the channel type structure for TCP socket
@@ -930,6 +933,35 @@ TcpGetOptionProc(
  */
 
 static void
+WrapNotify(
+    ClientData clientData,
+    int mask)
+{
+    TcpState *statePtr = (TcpState *) clientData;
+    int newmask = mask & statePtr->interest;
+
+    if (newmask == 0) {
+	/*
+	 * There was no overlap between the states the channel is
+	 * interested in notifications for, and the states that are
+	 * reported present on the file descriptor by select().  The
+	 * only way that can happen is when the channel is interested
+	 * in a writable condition, and only a readable state is reported
+	 * present (see TcpWatchProc() below).  In that case, signal back
+	 * to the caller the writable state, which is really an error
+	 * condition.  As an extra check on that assumption, check for
+	 * a non-zero value of errno before reporting an artificial
+	 * writable state.
+	 */
+	if (errno == 0) {
+	    return;
+	}
+	newmask = TCL_WRITABLE;
+    }
+    Tcl_NotifyChannel(statePtr->channel, newmask);
+}
+
+static void
 TcpWatchProc(
     ClientData instanceData,	/* The socket state. */
     int mask)			/* Events of interest; an OR-ed combination of
@@ -952,8 +984,30 @@ TcpWatchProc(
          * need to cache this request until the connection has succeeded. */
         statePtr->filehandlers = mask;
     } else if (mask) {
-        Tcl_CreateFileHandler(statePtr->fds.fd, mask,
-                (Tcl_FileProc *) Tcl_NotifyChannel, statePtr->channel);
+
+	/*
+	 * Whether it is a bug or feature or otherwise, it is a fact
+	 * of life that on at least some Linux kernels select() fails
+	 * to report that a socket file descriptor is writable when
+	 * the other end of the socket is closed.  This is in contrast
+	 * to the guarantees Tcl makes that its channels become
+	 * writable and fire writable events on an error conditon.
+	 * This has caused a leak of file descriptors in a state of
+	 * background flushing.  See Tcl ticket 1758a0b603.
+	 *
+	 * As a workaround, when our caller indicates an interest in
+	 * writable notifications, we must tell the notifier built
+	 * around select() that we are interested in the readable state
+	 * of the file descriptor as well, as that is the only reliable
+	 * means to get notified of error conditions.  Then it is the
+	 * task of WrapNotify() above to untangle the meaning of these
+	 * channel states and report the chan events as best it can.
+	 * We save a copy of the mask passed in to assist with that.
+	 */
+
+	statePtr->interest = mask;
+        Tcl_CreateFileHandler(statePtr->fds.fd, mask|TCL_READABLE,
+                (Tcl_FileProc *) WrapNotify, statePtr);
     } else {
         Tcl_DeleteFileHandler(statePtr->fds.fd);
     }
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c
index 4b0f369..c5ac52a 100644
--- a/unix/tclUnixTest.c
+++ b/unix/tclUnixTest.c
@@ -63,7 +63,7 @@ static const char *gotsig = "0";
  */
 
 static Tcl_CmdProc TestalarmCmd;
-static Tcl_CmdProc TestchmodCmd;
+static Tcl_ObjCmdProc TestchmodCmd;
 static Tcl_CmdProc TestfilehandlerCmd;
 static Tcl_CmdProc TestfilewaitCmd;
 static Tcl_CmdProc TestfindexecutableCmd;
@@ -96,7 +96,7 @@ int
 TclplatformtestInit(
     Tcl_Interp *interp)		/* Interpreter to add commands to. */
 {
-    Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
+    Tcl_CreateObjCommand(interp, "testchmod", TestchmodCmd,
 	    NULL, NULL);
     Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd,
 	    NULL, NULL);
@@ -740,29 +740,25 @@ static int
 TestchmodCmd(
     ClientData dummy,			/* Not used. */
     Tcl_Interp *interp,			/* Current interpreter. */
-    int argc,				/* Number of arguments. */
-    const char **argv)			/* Argument strings. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const *objv)		/* Argument strings. */
 {
     int i, mode;
-    char *rest;
 
-    if (argc < 2) {
-    usage:
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" mode file ?file ...?", NULL);
+    if (objc < 2) {
+    Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?");
 	return TCL_ERROR;
     }
 
-    mode = (int) strtol(argv[1], &rest, 8);
-    if ((rest == argv[1]) || (*rest != '\0')) {
-	goto usage;
+    if (Tcl_GetIntFromObj(interp, objv[1], &mode) != TCL_OK) {
+	return TCL_ERROR;
     }
 
-    for (i = 2; i < argc; i++) {
+    for (i = 2; i < objc; i++) {
 	Tcl_DString buffer;
 	const char *translated;
 
-	translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
+	translated = Tcl_TranslateFileName(interp, Tcl_GetString(objv[i]), &buffer);
 	if (translated == NULL) {
 	    return TCL_ERROR;
 	}
diff --git a/unix/tclXtTest.c b/unix/tclXtTest.c
index fcb0773..f7c2652 100644
--- a/unix/tclXtTest.c
+++ b/unix/tclXtTest.c
@@ -15,7 +15,7 @@
 #include <X11/Intrinsic.h>
 #include "tcl.h"
 
-static Tcl_CmdProc TesteventloopCmd;
+static Tcl_ObjCmdProc TesteventloopCmd;
 extern DLLEXPORT Tcl_PackageInitProc Tclxttest_Init;
 
 /*
@@ -53,7 +53,7 @@ Tclxttest_Init(
     }
     XtToolkitInitialize();
     InitNotifier();
-    Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
+    Tcl_CreateObjCommand(interp, "testeventloop", TesteventloopCmd,
 	    NULL, NULL);
     return TCL_OK;
 }
@@ -80,21 +80,20 @@ static int
 TesteventloopCmd(
     ClientData clientData,	/* Not used. */
     Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
 {
     static int *framePtr = NULL;/* Pointer to integer on stack frame of
 				 * innermost invocation of the "wait"
 				 * subcommand. */
 
-    if (argc < 2) {
-	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
-		" option ... \"", NULL);
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option ...");
 	return TCL_ERROR;
     }
-    if (strcmp(argv[1], "done") == 0) {
+    if (strcmp(Tcl_GetString(objv[1]), "done") == 0) {
 	*framePtr = 1;
-    } else if (strcmp(argv[1], "wait") == 0) {
+    } else if (strcmp(Tcl_GetString(objv[1]), "wait") == 0) {
 	int *oldFramePtr;
 	int done;
 	int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
@@ -118,7 +117,7 @@ TesteventloopCmd(
 	(void) Tcl_SetServiceMode(oldMode);
 	framePtr = oldFramePtr;
     } else {
-	Tcl_AppendResult(interp, "bad option \"", argv[1],
+	Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
 		"\": must be done or wait", NULL);
 	return TCL_ERROR;
     }