1 files changed, 163 insertions, 107 deletions

diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index dad0660..7ba2f2a 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -19,17 +19,28 @@
  * the transformation.
  */
 
-static Tcl_DriverBlockModeProc	TransformBlockModeProc;
-static Tcl_DriverCloseProc	TransformCloseProc;
-static Tcl_DriverInputProc	TransformInputProc;
-static Tcl_DriverOutputProc	TransformOutputProc;
-static Tcl_DriverSeekProc	TransformSeekProc;
-static Tcl_DriverSetOptionProc	TransformSetOptionProc;
-static Tcl_DriverGetOptionProc	TransformGetOptionProc;
-static Tcl_DriverWatchProc	TransformWatchProc;
-static Tcl_DriverGetHandleProc	TransformGetFileHandleProc;
-static Tcl_DriverHandlerProc	TransformNotifyProc;
-static Tcl_DriverWideSeekProc	TransformWideSeekProc;
+static int		TransformBlockModeProc(ClientData instanceData,
+			    int mode);
+static int		TransformCloseProc(ClientData instanceData,
+			    Tcl_Interp *interp);
+static int		TransformInputProc(ClientData instanceData, char *buf,
+			    int toRead, int *errorCodePtr);
+static int		TransformOutputProc(ClientData instanceData,
+			    const char *buf, int toWrite, int *errorCodePtr);
+static int		TransformSeekProc(ClientData instanceData, long offset,
+			    int mode, int *errorCodePtr);
+static int		TransformSetOptionProc(ClientData instanceData,
+			    Tcl_Interp *interp, const char *optionName,
+			    const char *value);
+static int		TransformGetOptionProc(ClientData instanceData,
+			    Tcl_Interp *interp, const char *optionName,
+			    Tcl_DString *dsPtr);
+static void		TransformWatchProc(ClientData instanceData, int mask);
+static int		TransformGetFileHandleProc(ClientData instanceData,
+			    int direction, ClientData *handlePtr);
+static int		TransformNotifyProc(ClientData instanceData, int mask);
+static Tcl_WideInt	TransformWideSeekProc(ClientData instanceData,
+			    Tcl_WideInt offset, int mode, int *errorCodePtr);
 
 /*
  * Forward declarations of internal procedures. Secondly the procedures for
@@ -47,7 +58,7 @@ typedef struct TransformChannelData TransformChannelData;
 
 static int		ExecuteCallback(TransformChannelData *ctrl,
 			    Tcl_Interp *interp, unsigned char *op,
-			    unsigned char *buf, size_t bufLen, int transmit,
+			    unsigned char *buf, int bufLen, int transmit,
 			    int preserve);
 
 /*
@@ -105,7 +116,7 @@ static inline void	ResultAdd(ResultBuffer *r, unsigned char *buf,
  * transformations.
  */
 
-static const Tcl_ChannelType transformChannelType = {
+static Tcl_ChannelType transformChannelType = {
     "transform",		/* Type name. */
     TCL_CHANNEL_VERSION_5,	/* v5 channel */
     TransformCloseProc,		/* Close proc. */
@@ -176,6 +187,7 @@ struct TransformChannelData {
     Tcl_Channel self;		/* Our own Channel handle. */
     int readIsFlushed;		/* Flag to note whether in.flushProc was
 				 * called or not. */
+    int eofPending;		/* Flag: EOF seen down, not raised up */
     int flags;			/* Currently CHANNEL_ASYNC or zero. */
     int watchMask;		/* Current watch/event/interest mask. */
     int mode;			/* Mode of parent channel, OR'ed combination
@@ -188,7 +200,7 @@ struct TransformChannelData {
      * Transformation specific data.
      */
 
-    size_t maxRead;		/* Maximum allowed number of bytes to read, as
+    int maxRead;		/* Maximum allowed number of bytes to read, as
 				 * given to us by the Tcl script implementing
 				 * the transformation. */
     Tcl_Interp *interp;		/* Reference to the interpreter which created
@@ -199,7 +211,27 @@ struct TransformChannelData {
 				 * a transformation of incoming data. Also
 				 * serves as buffer of all data not yet
 				 * consumed by the reader. */
+    int refCount;
 };
+
+static void
+PreserveData(
+    TransformChannelData *dataPtr)
+{
+    dataPtr->refCount++;
+}
+
+static void
+ReleaseData(
+    TransformChannelData *dataPtr)
+{
+    if (--dataPtr->refCount) {
+	return;
+    }
+    ResultClear(&dataPtr->result);
+    Tcl_DecrRefCount(dataPtr->command);
+    ckfree((char *) dataPtr);
+}
 
 /*
  *----------------------------------------------------------------------
@@ -229,6 +261,7 @@ TclChannelTransform(
     Channel *chanPtr;		/* The actual channel. */
     ChannelState *statePtr;	/* State info for channel. */
     int mode;			/* Read/write mode of the channel. */
+    int objc;
     TransformChannelData *dataPtr;
     Tcl_DString ds;
 
@@ -236,6 +269,12 @@ TclChannelTransform(
 	return TCL_ERROR;
     }
 
+    if (TCL_OK != Tcl_ListObjLength(interp, cmdObjPtr, &objc)) {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("-command value is not a list", -1));
+	return TCL_ERROR;
+    }
+
     chanPtr = (Channel *) chan;
     statePtr = chanPtr->state;
     chanPtr = statePtr->topChanPtr;
@@ -248,18 +287,19 @@ TclChannelTransform(
      * regime of the underlying channel and to use the same for us too.
      */
 
-    dataPtr = ckalloc(sizeof(TransformChannelData));
+    dataPtr = (TransformChannelData *) ckalloc(sizeof(TransformChannelData));
 
+    dataPtr->refCount = 1;
     Tcl_DStringInit(&ds);
     Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
     dataPtr->readIsFlushed = 0;
+    dataPtr->eofPending = 0;
     dataPtr->flags = 0;
     if (ds.string[0] == '0') {
 	dataPtr->flags |= CHANNEL_ASYNC;
     }
     Tcl_DStringFree(&ds);
 
-    dataPtr->self = chan;
     dataPtr->watchMask = 0;
     dataPtr->mode = mode;
     dataPtr->timer = NULL;
@@ -273,21 +313,22 @@ TclChannelTransform(
     dataPtr->self = Tcl_StackChannel(interp, &transformChannelType, dataPtr,
 	    mode, chan);
     if (dataPtr->self == NULL) {
-	Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp),
-		"\nfailed to stack channel \"%s\"", Tcl_GetChannelName(chan));
-	Tcl_DecrRefCount(dataPtr->command);
-	ResultClear(&dataPtr->result);
-	ckfree(dataPtr);
+	Tcl_AppendResult(interp, "\nfailed to stack channel \"",
+		Tcl_GetChannelName(chan), "\"", NULL);
+	ReleaseData(dataPtr);
 	return TCL_ERROR;
     }
+    Tcl_Preserve(dataPtr->self);
 
     /*
      * At last initialize the transformation at the script level.
      */
 
+    PreserveData(dataPtr);
     if ((dataPtr->mode & TCL_WRITABLE) && ExecuteCallback(dataPtr, NULL,
 	    A_CREATE_WRITE, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK){
 	Tcl_UnstackChannel(interp, chan);
+	ReleaseData(dataPtr);
 	return TCL_ERROR;
     }
 
@@ -296,9 +337,11 @@ TclChannelTransform(
 	ExecuteCallback(dataPtr, NULL, A_DELETE_WRITE, NULL, 0, TRANSMIT_DONT,
 		P_NO_PRESERVE);
 	Tcl_UnstackChannel(interp, chan);
+	ReleaseData(dataPtr);
 	return TCL_ERROR;
     }
 
+    ReleaseData(dataPtr);
     return TCL_OK;
 }
 
@@ -326,7 +369,7 @@ ExecuteCallback(
     Tcl_Interp *interp,		/* Current interpreter, possibly NULL. */
     unsigned char *op,		/* Operation invoking the callback. */
     unsigned char *buf,		/* Buffer to give to the script. */
-    size_t bufLen,		/* And its length. */
+    int bufLen,			/* And its length. */
     int transmit,		/* Flag, determines whether the result of the
 				 * callback is sent to the underlying channel
 				 * or not. */
@@ -335,12 +378,14 @@ ExecuteCallback(
 				 * interpreters. */
 {
     Tcl_Obj *resObj;		/* See below, switch (transmit). */
-    size_t resLen;
-    int maxRead;
+    int resLen;
     unsigned char *resBuf;
     Tcl_InterpState state = NULL;
     int res = TCL_OK;
-    Tcl_Obj *command = Tcl_DuplicateObj(dataPtr->command);
+    Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);
+    Tcl_Interp *eval = dataPtr->interp;
+
+    Tcl_Preserve(eval);
 
     /*
      * Step 1, create the complete command to execute. Do this by appending
@@ -351,26 +396,18 @@ ExecuteCallback(
      */
 
     if (preserve == P_PRESERVE) {
-	state = Tcl_SaveInterpState(dataPtr->interp, res);
+	state = Tcl_SaveInterpState(eval, res);
     }
 
     Tcl_IncrRefCount(command);
-    res = Tcl_ListObjAppendElement(dataPtr->interp, command,
-	    Tcl_NewStringObj((char *) op, TCL_STRLEN));
-    if (res != TCL_OK) {
-	goto cleanup;
-    }
+    Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1));
 
     /*
      * Use a byte-array to prevent the misinterpretation of binary data coming
      * through as UTF while at the tcl level.
      */
 
-    res = Tcl_ListObjAppendElement(dataPtr->interp, command,
-	    Tcl_NewByteArrayObj(buf, bufLen));
-    if (res != TCL_OK) {
-	goto cleanup;
-    }
+    Tcl_ListObjAppendElement(NULL, command, Tcl_NewByteArrayObj(buf, bufLen));
 
     /*
      * Step 2, execute the command at the global level of the interpreter used
@@ -380,13 +417,14 @@ ExecuteCallback(
      * current interpreter. Don't copy if in preservation mode.
      */
 
-    res = Tcl_EvalObjEx(dataPtr->interp, command, TCL_EVAL_GLOBAL);
+    res = Tcl_EvalObjEx(eval, command, TCL_EVAL_GLOBAL);
     Tcl_DecrRefCount(command);
     command = NULL;
 
-    if ((res != TCL_OK) && (interp != NULL) && (dataPtr->interp != interp)
+    if ((res != TCL_OK) && (interp != NULL) && (eval != interp)
 	    && (preserve == P_NO_PRESERVE)) {
-	Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));
+	Tcl_SetObjResult(interp, Tcl_GetObjResult(eval));
+	Tcl_Release(eval);
 	return res;
     }
 
@@ -401,20 +439,26 @@ ExecuteCallback(
 	break;
 
     case TRANSMIT_DOWN:
-	resObj = Tcl_GetObjResult(dataPtr->interp);
+	if (dataPtr->self == NULL) {
+	    break;
+	}
+	resObj = Tcl_GetObjResult(eval);
 	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
 	Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf,
 		resLen);
 	break;
 
     case TRANSMIT_SELF:
-	resObj = Tcl_GetObjResult(dataPtr->interp);
+	if (dataPtr->self == NULL) {
+	    break;
+	}
+	resObj = Tcl_GetObjResult(eval);
 	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
 	Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
 	break;
 
     case TRANSMIT_IBUF:
-	resObj = Tcl_GetObjResult(dataPtr->interp);
+	resObj = Tcl_GetObjResult(eval);
 	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
 	ResultAdd(&dataPtr->result, resBuf, resLen);
 	break;
@@ -424,25 +468,16 @@ ExecuteCallback(
 	 * Interpret result as integer number.
 	 */
 
-	resObj = Tcl_GetObjResult(dataPtr->interp);
-	TclGetIntFromObj(dataPtr->interp, resObj, &maxRead);
-	dataPtr->maxRead = (size_t) maxRead;
+	resObj = Tcl_GetObjResult(eval);
+	TclGetIntFromObj(eval, resObj, &dataPtr->maxRead);
 	break;
     }
 
-    Tcl_ResetResult(dataPtr->interp);
+    Tcl_ResetResult(eval);
     if (preserve == P_PRESERVE) {
-	(void) Tcl_RestoreInterpState(dataPtr->interp, state);
-    }
-    return res;
-
-  cleanup:
-    if (preserve == P_PRESERVE) {
-	(void) Tcl_RestoreInterpState(dataPtr->interp, state);
-    }
-    if (command != NULL) {
-	Tcl_DecrRefCount(command);
+	(void) Tcl_RestoreInterpState(eval, state);
     }
+    Tcl_Release(eval);
     return res;
 }
 
@@ -526,6 +561,7 @@ TransformCloseProc(
      * system rely on (f.e. signaling the close to interested parties).
      */
 
+    PreserveData(dataPtr);
     if (dataPtr->mode & TCL_WRITABLE) {
 	ExecuteCallback(dataPtr, interp, A_FLUSH_WRITE, NULL, 0,
 		TRANSMIT_DOWN, P_PRESERVE);
@@ -545,14 +581,15 @@ TransformCloseProc(
 	ExecuteCallback(dataPtr, interp, A_DELETE_READ, NULL, 0,
 		TRANSMIT_DONT, P_PRESERVE);
     }
+    ReleaseData(dataPtr);
 
     /*
      * General cleanup.
      */
 
-    ResultClear(&dataPtr->result);
-    Tcl_DecrRefCount(dataPtr->command);
-    ckfree(dataPtr);
+    Tcl_Release(dataPtr->self);
+    dataPtr->self = NULL;
+    ReleaseData(dataPtr);
     return TCL_OK;
 }
 
@@ -572,24 +609,24 @@ TransformCloseProc(
  *----------------------------------------------------------------------
  */
 
-static ssize_t
+static int
 TransformInputProc(
     ClientData instanceData,
     char *buf,
-    size_t toRead,
+    int toRead,
     int *errorCodePtr)
 {
     TransformChannelData *dataPtr = instanceData;
-    ssize_t gotBytes, read, copied;
+    int gotBytes, read, copied;
     Tcl_Channel downChan;
 
     /*
      * Should assert(dataPtr->mode & TCL_READABLE);
      */
 
-    if (toRead == 0) {
+    if (toRead == 0 || dataPtr->self == NULL) {
 	/*
-	 * Catch a no-op.
+	 * Catch a no-op. TODO: Is this a panic()?
 	 */
 	return 0;
     }
@@ -597,6 +634,7 @@ TransformInputProc(
     gotBytes = 0;
     downChan = Tcl_GetStackedChannel(dataPtr->self);
 
+    PreserveData(dataPtr);
     while (toRead > 0) {
 	/*
 	 * Loop until the request is satisfied (or no data is available from
@@ -614,7 +652,7 @@ TransformInputProc(
 	     * break out of the loop and return to the caller.
 	     */
 
-	    return gotBytes;
+	    break;
 	}
 
 	/*
@@ -638,7 +676,18 @@ TransformInputProc(
 	    }
 	} /* else: 'maxRead < 0' == Accept the current value of toRead. */
 	if (toRead <= 0) {
-	    return gotBytes;
+	    break;
+	}
+	if (dataPtr->eofPending) {
+	    /*
+	     * Already saw EOF from downChan; don't ask again.
+	     * NOTE: Could move this up to avoid the last maxRead
+	     * execution.  Believe this would still be correct behavior,
+	     * but the test suite tests the whole command callback 
+	     * sequence, so leave it unchanged for now.
+	     */
+
+	    break;
 	}
 
 	/*
@@ -647,45 +696,36 @@ TransformInputProc(
 
 	read = Tcl_ReadRaw(downChan, buf, toRead);
 	if (read < 0) {
-	    /*
-	     * Report errors to caller. EAGAIN is a special situation. If we
-	     * had some data before we report that instead of the request to
-	     * re-try.
-	     */
 
-	    if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
-		return gotBytes;
+	    if (Tcl_InputBlocked(downChan) && (gotBytes > 0)) {
+		/*
+		 * Zero bytes available from downChan because blocked.
+		 * But nonzero bytes already copied, so total is a
+		 * valid blocked short read. Return to caller.
+		 */
+
+		break;
 	    }
 
-	    *errorCodePtr = Tcl_GetErrno();
-	    return -1;
-	} else if (read == 0) {
 	    /*
-	     * Check wether we hit on EOF in the underlying channel or not. If
-	     * not differentiate between blocking and non-blocking modes. In
-	     * non-blocking mode we ran temporarily out of data. Signal this
-	     * to the caller via EWOULDBLOCK and error return (-1). In the
-	     * other cases we simply return what we got and let the caller
-	     * wait for more. On the other hand, if we got an EOF we have to
-	     * convert and flush all waiting partial data.
+	     * Either downChan is not blocked (there's a real error).
+	     * or it is and there are no bytes copied yet.  In either
+	     * case we want to pass the "error" along to the caller,
+	     * either to report an error, or to signal to the caller
+	     * that zero bytes are available because blocked.
 	     */
 
-	    if (!Tcl_Eof(downChan)) {
-		if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
-		    *errorCodePtr = EWOULDBLOCK;
-		    return -1;
-		}
-		return gotBytes;
-	    }
-
-	    if (dataPtr->readIsFlushed) {
-		/*
-		 * Already flushed, nothing to do anymore.
-		 */
+	    *errorCodePtr = Tcl_GetErrno();
+	    gotBytes = -1;
+	    break;
+	} else if (read == 0) {
 
-		return gotBytes;
-	    }
+	    /*
+	     * Zero returned from Tcl_ReadRaw() always indicates EOF
+	     * on the down channel.
+	     */
 
+	    dataPtr->eofPending = 1;
 	    dataPtr->readIsFlushed = 1;
 	    ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0,
 		    TRANSMIT_IBUF, P_PRESERVE);
@@ -695,7 +735,7 @@ TransformInputProc(
 		 * We had nothing to flush.
 		 */
 
-		return gotBytes;
+		break;
 	    }
 
 	    continue;		/* at: while (toRead > 0) */
@@ -709,10 +749,15 @@ TransformInputProc(
 	if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
 		TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) {
 	    *errorCodePtr = EINVAL;
-	    return -1;
+	    gotBytes = -1;
+	    break;
 	}
     } /* while toRead > 0 */
 
+    if (gotBytes == 0) {
+	dataPtr->eofPending = 0;
+    }
+    ReleaseData(dataPtr);
     return gotBytes;
 }
 
@@ -732,11 +777,11 @@ TransformInputProc(
  *----------------------------------------------------------------------
  */
 
-static ssize_t
+static int
 TransformOutputProc(
     ClientData instanceData,
     const char *buf,
-    size_t toWrite,
+    int toWrite,
     int *errorCodePtr)
 {
     TransformChannelData *dataPtr = instanceData;
@@ -753,11 +798,13 @@ TransformOutputProc(
 	return 0;
     }
 
+    PreserveData(dataPtr);
     if (ExecuteCallback(dataPtr, NULL, A_WRITE, UCHARP(buf), toWrite,
 	    TRANSMIT_DOWN, P_NO_PRESERVE) != TCL_OK) {
 	*errorCodePtr = EINVAL;
-	return -1;
+	toWrite = -1;
     }
+    ReleaseData(dataPtr);
 
     return toWrite;
 }
@@ -791,7 +838,7 @@ TransformSeekProc(
 {
     TransformChannelData *dataPtr = instanceData;
     Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
-    const Tcl_ChannelType *parentType = Tcl_GetChannelType(parent);
+    Tcl_ChannelType *parentType = Tcl_GetChannelType(parent);
     Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
 
     if ((offset == 0) && (mode == SEEK_CUR)) {
@@ -810,6 +857,7 @@ TransformSeekProc(
      * request down, unchanged.
      */
 
+    PreserveData(dataPtr);
     if (dataPtr->mode & TCL_WRITABLE) {
 	ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
 		P_NO_PRESERVE);
@@ -820,7 +868,9 @@ TransformSeekProc(
 		P_NO_PRESERVE);
 	ResultClear(&dataPtr->result);
 	dataPtr->readIsFlushed = 0;
+	dataPtr->eofPending = 0;
     }
+    ReleaseData(dataPtr);
 
     return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode,
 	    errorCodePtr);
@@ -855,7 +905,7 @@ TransformWideSeekProc(
 {
     TransformChannelData *dataPtr = instanceData;
     Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
-    const Tcl_ChannelType *parentType	= Tcl_GetChannelType(parent);
+    Tcl_ChannelType *parentType	= Tcl_GetChannelType(parent);
     Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
     Tcl_DriverWideSeekProc *parentWideSeekProc =
 	    Tcl_ChannelWideSeekProc(parentType);
@@ -881,6 +931,7 @@ TransformWideSeekProc(
      * request down, unchanged.
      */
 
+    PreserveData(dataPtr);
     if (dataPtr->mode & TCL_WRITABLE) {
 	ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
 		P_NO_PRESERVE);
@@ -891,7 +942,9 @@ TransformWideSeekProc(
 		P_NO_PRESERVE);
 	ResultClear(&dataPtr->result);
 	dataPtr->readIsFlushed = 0;
+	dataPtr->eofPending = 0;
     }
+    ReleaseData(dataPtr);
 
     /*
      * If we have a wide seek capability, we should stick with that.
@@ -1046,6 +1099,9 @@ TransformWatchProc(
      * unchanged.
      */
 
+    if (dataPtr->self == NULL) {
+	return;
+    }
     downChan = Tcl_GetStackedChannel(dataPtr->self);
 
     Tcl_GetChannelType(downChan)->watchProc(
@@ -1218,7 +1274,7 @@ ResultClear(
     r->used = 0;
 
     if (r->allocated) {
-	ckfree(r->buf);
+	ckfree((char *) r->buf);
 	r->buf = NULL;
 	r->allocated = 0;
     }
@@ -1362,10 +1418,10 @@ ResultAdd(
 
 	if (r->allocated == 0) {
 	    r->allocated = toWrite + INCREMENT;
-	    r->buf = ckalloc(r->allocated);
+	    r->buf = UCHARP(ckalloc(r->allocated));
 	} else {
 	    r->allocated += toWrite + INCREMENT;
-	    r->buf = ckrealloc(r->buf, r->allocated);
+	    r->buf = UCHARP(ckrealloc((char *) r->buf, r->allocated));
 	}
     }