Merge up to the 8.6.0 release.

1 files changed, 92 insertions, 76 deletions

diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index 2f8cbd9..458b05b 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -10,8 +10,6 @@
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
  * Serial functionality implemented by Rolf.Schroedter@dlr.de
- *
- * RCS: @(#) $Id: tclWinSerial.c,v 1.44 2010/09/13 14:20:38 nijtmans Exp $
  */
 
 #include "tclWinInt.h"
@@ -378,7 +376,7 @@ SerialGetMilliseconds(void)
 {
     Tcl_Time time;
 
-    TclpGetTime(&time);
+    Tcl_GetTime(&time);
 
     return (time.sec * 1000 + time.usec / 1000);
 }
@@ -531,7 +529,7 @@ SerialCheckProc(
 
 	if (needEvent) {
 	    infoPtr->flags |= SERIAL_PENDING;
-	    evPtr = (SerialEvent *) ckalloc(sizeof(SerialEvent));
+	    evPtr = ckalloc(sizeof(SerialEvent));
 	    evPtr->header.proc = SerialEventProc;
 	    evPtr->infoPtr = infoPtr;
 	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -710,7 +708,7 @@ SerialCloseProc(
 	ckfree(serialPtr->writeBuf);
 	serialPtr->writeBuf = NULL;
     }
-    ckfree((char*) serialPtr);
+    ckfree(serialPtr);
 
     if (errorCode == 0) {
 	return result;
@@ -1038,7 +1036,7 @@ SerialOutputProc(
 	 * the channel is in non-blocking mode.
 	 */
 
-	errno = EWOULDBLOCK;
+	errno = EAGAIN;
 	goto error1;
     }
 
@@ -1075,7 +1073,7 @@ SerialOutputProc(
 		ckfree(infoPtr->writeBuf);
 	    }
 	    infoPtr->writeBufLen = toWrite;
-	    infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
+	    infoPtr->writeBuf = ckalloc(toWrite);
 	}
 	memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
 	infoPtr->toWrite = toWrite;
@@ -1435,9 +1433,7 @@ TclWinSerialReopen(
     const TCHAR *name,
     DWORD access)
 {
-    ThreadSpecificData *tsdPtr;
-
-    tsdPtr = SerialInit();
+    SerialInit();
 
     /*
      * Multithreaded I/O needs the overlapped flag set otherwise
@@ -1482,7 +1478,7 @@ TclWinOpenSerialChannel(
 
     SerialInit();
 
-    infoPtr = (SerialInfo *) ckalloc((unsigned) sizeof(SerialInfo));
+    infoPtr = ckalloc(sizeof(SerialInfo));
     memset(infoPtr, 0, sizeof(SerialInfo));
 
     infoPtr->validMask = permissions;
@@ -1503,7 +1499,7 @@ TclWinOpenSerialChannel(
      * are shared between multiple channels (stdin/stdout).
      */
 
-    wsprintfA(channelName, "file%lx", (int) infoPtr);
+    sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
 
     infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
 	    infoPtr, permissions);
@@ -1677,10 +1673,7 @@ SerialSetOptionProc(
 
     if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) {
 	if (!GetCommState(infoPtr->handle, &dcb)) {
-	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "can't get comm state", NULL);
-	    }
-	    return TCL_ERROR;
+	    goto getStateFailed;
 	}
 	native = Tcl_WinUtfToTChar(value, -1, &ds);
 	result = BuildCommDCB(native, &dcb);
@@ -1688,8 +1681,10 @@ SerialSetOptionProc(
 
 	if (result == FALSE) {
 	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "bad value \"", value,
-			"\" for -mode: should be baud,parity,data,stop", NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"bad value \"%s\" for -mode: should be baud,parity,data,stop",
+			value));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
 	    }
 	    return TCL_ERROR;
 	}
@@ -1704,10 +1699,7 @@ SerialSetOptionProc(
 	dcb.fAbortOnError = FALSE;
 
 	if (!SetCommState(infoPtr->handle, &dcb)) {
-	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "can't set comm state", NULL);
-	    }
-	    return TCL_ERROR;
+	    goto setStateFailed;
 	}
 	return TCL_OK;
     }
@@ -1718,10 +1710,7 @@ SerialSetOptionProc(
 
     if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
 	if (!GetCommState(infoPtr->handle, &dcb)) {
-	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "can't get comm state", NULL);
-	    }
-	    return TCL_ERROR;
+	    goto getStateFailed;
 	}
 
 	/*
@@ -1756,18 +1745,16 @@ SerialSetOptionProc(
 	    dcb.fDtrControl = DTR_CONTROL_HANDSHAKE;
 	} else {
 	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "bad value \"", value,
-			"\" for -handshake: must be one of xonxoff, rtscts, "
-			"dtrdsr or none", NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"bad value \"%s\" for -handshake: must be one of"
+			" xonxoff, rtscts, dtrdsr or none", value));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "HANDSHAKE", NULL);
 	    }
 	    return TCL_ERROR;
 	}
 
 	if (!SetCommState(infoPtr->handle, &dcb)) {
-	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "can't set comm state", NULL);
-	    }
-	    return TCL_ERROR;
+	    goto setStateFailed;
 	}
 	return TCL_OK;
     }
@@ -1778,10 +1765,7 @@ SerialSetOptionProc(
 
     if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
 	if (!GetCommState(infoPtr->handle, &dcb)) {
-	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "can't get comm state", NULL);
-	    }
-	    return TCL_ERROR;
+	    goto getStateFailed;
 	}
 
 	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
@@ -1790,11 +1774,12 @@ SerialSetOptionProc(
 	if (argc != 2) {
 	badXchar:
 	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "bad value for -xchar: should be "
-			"a list of two elements with each a single character",
-			NULL);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"bad value for -xchar: should be a list of"
+			" two elements with each a single character", -1));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL);
 	    }
-	    ckfree((char *) argv);
+	    ckfree(argv);
 	    return TCL_ERROR;
 	}
 
@@ -1825,13 +1810,10 @@ SerialSetOptionProc(
 	    }
 	    dcb.XoffChar = (char) character;
 	}
-	ckfree((char *) argv);
+	ckfree(argv);
 
 	if (!SetCommState(infoPtr->handle, &dcb)) {
-	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "can't set comm state", NULL);
-	    }
-	    return TCL_ERROR;
+	    goto setStateFailed;
 	}
 	return TCL_OK;
     }
@@ -1848,11 +1830,12 @@ SerialSetOptionProc(
 	}
 	if ((argc % 2) == 1) {
 	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "bad value \"", value,
-			"\" for -ttycontrol: should be a list of "
-			"signal,value pairs", NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"bad value \"%s\" for -ttycontrol: should be "
+			"a list of signal,value pairs", value));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL);
 	    }
-	    ckfree((char *) argv);
+	    ckfree(argv);
 	    return TCL_ERROR;
 	}
 
@@ -1865,7 +1848,10 @@ SerialSetOptionProc(
 		if (!EscapeCommFunction(infoPtr->handle,
 			(DWORD) (flag ? SETDTR : CLRDTR))) {
 		    if (interp != NULL) {
-			Tcl_AppendResult(interp, "can't set DTR signal", NULL);
+			Tcl_SetObjResult(interp, Tcl_NewStringObj(
+				"can't set DTR signal", -1));
+			Tcl_SetErrorCode(interp, "TCL", "OPERATION",
+				"FCONFIGURE", "TTY_SIGNAL", NULL);
 		    }
 		    result = TCL_ERROR;
 		    break;
@@ -1874,7 +1860,10 @@ SerialSetOptionProc(
 		if (!EscapeCommFunction(infoPtr->handle,
 			(DWORD) (flag ? SETRTS : CLRRTS))) {
 		    if (interp != NULL) {
-			Tcl_AppendResult(interp, "can't set RTS signal", NULL);
+			Tcl_SetObjResult(interp, Tcl_NewStringObj(
+				"can't set RTS signal", -1));
+			Tcl_SetErrorCode(interp, "TCL", "OPERATION",
+				"FCONFIGURE", "TTY_SIGNAL", NULL);
 		    }
 		    result = TCL_ERROR;
 		    break;
@@ -1883,15 +1872,20 @@ SerialSetOptionProc(
 		if (!EscapeCommFunction(infoPtr->handle,
 			(DWORD) (flag ? SETBREAK : CLRBREAK))) {
 		    if (interp != NULL) {
-			Tcl_AppendResult(interp,"can't set BREAK signal",NULL);
+			Tcl_SetObjResult(interp, Tcl_NewStringObj(
+				"can't set BREAK signal", -1));
+			Tcl_SetErrorCode(interp, "TCL", "OPERATION",
+				"FCONFIGURE", "TTY_SIGNAL", NULL);
 		    }
 		    result = TCL_ERROR;
 		    break;
 		}
 	    } else {
 		if (interp != NULL) {
-		    Tcl_AppendResult(interp, "bad signal name \"", argv[i],
-			    "\" for -ttycontrol: must be DTR, RTS or BREAK",
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "bad signal name \"%s\" for -ttycontrol: must be"
+			    " DTR, RTS or BREAK", argv[i]));
+		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTY_SIGNAL",
 			    NULL);
 		}
 		result = TCL_ERROR;
@@ -1899,7 +1893,7 @@ SerialSetOptionProc(
 	    }
 	}
 
-	ckfree((char *) argv);
+	ckfree(argv);
 	return result;
     }
 
@@ -1925,20 +1919,24 @@ SerialSetOptionProc(
 	    inSize  = atoi(argv[0]);
 	    outSize = atoi(argv[1]);
 	}
-	ckfree((char *) argv);
+	ckfree(argv);
 
 	if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) {
 	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "bad value \"", value,
-			"\" for -sysbuffer: should be a list of one or two "
-			"integers > 0", NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"bad value \"%s\" for -sysbuffer: should be "
+			"a list of one or two integers > 0", value));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL);
 	    }
 	    return TCL_ERROR;
 	}
 
 	if (!SetupComm(infoPtr->handle, inSize, outSize)) {
 	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "can't setup comm buffers", NULL);
+		TclWinConvertError(GetLastError());
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"can't setup comm buffers: %s",
+			Tcl_PosixError(interp)));
 	    }
 	    return TCL_ERROR;
 	}
@@ -1951,18 +1949,12 @@ SerialSetOptionProc(
 	 */
 
 	if (!GetCommState(infoPtr->handle, &dcb)) {
-	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "can't get comm state", NULL);
-	    }
-	    return TCL_ERROR;
+	    goto getStateFailed;
 	}
 	dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2);
 	dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4);
 	if (!SetCommState(infoPtr->handle, &dcb)) {
-	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "can't set comm state", NULL);
-	    }
-	    return TCL_ERROR;
+	    goto setStateFailed;
 	}
 	return TCL_OK;
     }
@@ -1992,7 +1984,10 @@ SerialSetOptionProc(
 	tout.ReadTotalTimeoutConstant = msec;
 	if (!SetCommTimeouts(infoPtr->handle, &tout)) {
 	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "can't set comm timeouts", NULL);
+		TclWinConvertError(GetLastError());
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"can't set comm timeouts: %s",
+			Tcl_PosixError(interp)));
 	    }
 	    return TCL_ERROR;
 	}
@@ -2002,6 +1997,22 @@ SerialSetOptionProc(
 
     return Tcl_BadChannelOption(interp, optionName,
 	    "mode handshake pollinterval sysbuffer timeout ttycontrol xchar");
+
+  getStateFailed:
+    if (interp != NULL) {
+	TclWinConvertError(GetLastError());
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't get comm state: %s", Tcl_PosixError(interp)));
+    }
+    return TCL_ERROR;
+
+  setStateFailed:
+    if (interp != NULL) {
+	TclWinConvertError(GetLastError());
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't set comm state: %s", Tcl_PosixError(interp)));
+    }
+    return TCL_ERROR;
 }
 
 /*
@@ -2059,7 +2070,9 @@ SerialGetOptionProc(
 
 	if (!GetCommState(infoPtr->handle, &dcb)) {
 	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "can't get comm state", NULL);
+		TclWinConvertError(GetLastError());
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"can't get comm state: %s", Tcl_PosixError(interp)));
 	    }
 	    return TCL_ERROR;
 	}
@@ -2127,7 +2140,9 @@ SerialGetOptionProc(
 
 	if (!GetCommState(infoPtr->handle, &dcb)) {
 	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "can't get comm state", NULL);
+		TclWinConvertError(GetLastError());
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"can't get comm state: %s", Tcl_PosixError(interp)));
 	    }
 	    return TCL_ERROR;
 	}
@@ -2203,7 +2218,9 @@ SerialGetOptionProc(
 
 	if (!GetCommModemStatus(infoPtr->handle, &status)) {
 	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "can't get tty status", NULL);
+		TclWinConvertError(GetLastError());
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"can't get tty status: %s", Tcl_PosixError(interp)));
 	    }
 	    return TCL_ERROR;
 	}
@@ -2213,10 +2230,9 @@ SerialGetOptionProc(
 
     if (valid) {
 	return TCL_OK;
-    } else {
-	return Tcl_BadChannelOption(interp, optionName,
-		"mode pollinterval lasterror queue sysbuffer ttystatus xchar");
     }
+    return Tcl_BadChannelOption(interp, optionName,
+	    "mode pollinterval lasterror queue sysbuffer ttystatus xchar");
 }
 
 /*