Make [zlib push] work with [fcopy].

3 files changed, 193 insertions, 103 deletions

diff --git a/ChangeLog b/ChangeLog
index edd9aed..58cdc2f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,30 +1,37 @@
+2009-07-05  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclZlib.c (ZlibTransformWatch): Correct the handling of
+	events so that channel transforms work with things like an asynch
+	[chan copy]. Problem reported by Pat Thoyts.
+
 2009-07-01  Pat Thoyts  <patthoyts@users.sourceforge.net>
 
-	* win/tclWinInt.h:   Handle the GetUserName API call via the
-	* win/tclWin32Dll.c: tclWinProcs indirection structure. This
-	* win/tclWinInit.c:  fixes a problem obtaining the username when
-	the USERNAME environment variable is unset [Bug 2806622]
+	* win/tclWinInt.h:   [Bug 2806622]: Handle the GetUserName API call
+	* win/tclWin32Dll.c: via the tclWinProcs indirection structure. This
+	* win/tclWinInit.c:  fixes a problem obtaining the username when the
+	USERNAME environment variable is unset.
 
 2009-06-30  Daniel Steffen  <das@users.sourceforge.net>
 
-	* generic/tclInt.h:		add assert macros for clang static
+	* generic/tclInt.h:		Add assert macros for clang static
 	* generic/tclPanic.c:		analyzer and redefine Tcl_Panic to
 	* generic/tclStubInit.c:	assert after panic in clang PURIFY
 					builds.
 
-	* generic/tclCmdIL.c:		add clang assert for false positive
+	* generic/tclCmdIL.c:		Add clang assert for false positive
 					from static analyzer.
 
 2009-06-26  Daniel Steffen  <das@users.sourceforge.net>
 
-	* macosx/Tcl-Common.xcconfig:	update projects for Xcode 3.1 and 3.2,
-	* macosx/Tcl.xcode/*:		standardize on gcc 4.2, remove obsolete
-	* macosx/Tcl.xcodeproj/*:	configurations and pre-Xcode project.
-	* macosx/Tcl.pbproj/* (removed):
+	* macosx/Tcl-Common.xcconfig:	 Update projects for Xcode 3.1 and
+	* macosx/Tcl.xcode/*:		 3.2, standardize on gcc 4.2, remove
+	* macosx/Tcl.xcodeproj/*:	 obsolete configurations and pre-Xcode
+	* macosx/Tcl.pbproj/* (removed): project.
 
-	* macosx/README:		update project docs, cleanup.
+	* macosx/README:		 Update project docs, cleanup.
 
-	* unix/Makefile.in:		update dist target for project changes.
+	* unix/Makefile.in:		 Update dist target for project
+					 changes.
 
 2009-06-24  Donal K. Fellows  <dkf@users.sf.net>
 
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 7bac35a..8204da3 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclZlib.c,v 1.26 2009/03/04 17:52:34 dkf Exp $
+ * RCS: @(#) $Id: tclZlib.c,v 1.27 2009/07/05 16:05:59 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -83,6 +83,7 @@ typedef struct {
  */
 
 typedef struct {
+    Tcl_Channel chan;		/* Reference to the channel itself. */
     Tcl_Channel parent;		/* The underlying source and sink of bytes. */
     int flags;			/* General flag bits, see below... */
     int mode;			/* Either the value TCL_ZLIB_STREAM_DEFLATE
@@ -100,6 +101,7 @@ typedef struct {
 				 * decompressing a gzip stream. */
     GzipHeader outHeader;	/* Header to write to an output stream, when
 				 * compressing a gzip stream. */
+    Tcl_TimerToken timer;	/* Timer used for keeping events fresh. */
 } ZlibChannelData;
 
 /*
@@ -122,29 +124,38 @@ typedef struct {
 #define DEFAULT_BUFFER_SIZE	4096
 
 /*
+ * Time to wait (in milliseconds) before flushing the channel when reading
+ * data through the transform.
+ */
+
+#define TRANSFORM_FLUSH_DELAY	5
+
+/*
  * Prototypes for private procedures defined later in this file:
  */
 
-static int		ChanClose(ClientData instanceData,
+static int		ZlibTransformClose(ClientData instanceData,
 			    Tcl_Interp *interp);
-static int		ChanInput(ClientData instanceData, char *buf,
+static int		ZlibTransformInput(ClientData instanceData, char *buf,
 			    int toRead, int *errorCodePtr);
-static int		ChanOutput(ClientData instanceData, const char *buf,
-			    int toWrite, int*errorCodePtr);
-static int		ChanSetOption(ClientData instanceData,
+static int		ZlibTransformOutput(ClientData instanceData,
+			    const char *buf, int toWrite, int*errorCodePtr);
+static int		ZlibTransformSetOption(ClientData instanceData,
 			    Tcl_Interp *interp, const char *optionName,
 			    const char *value);
-static int		ChanGetOption(ClientData instanceData,
+static int		ZlibTransformGetOption(ClientData instanceData,
 			    Tcl_Interp *interp, const char *optionName,
 			    Tcl_DString *dsPtr);
-static void		ChanWatch(ClientData instanceData, int mask);
-static int		ChanGetHandle(ClientData instanceData, int direction,
-			    ClientData *handlePtr);
-static int		ChanBlockMode(ClientData instanceData, int mode);
-#if 0 /* unused */
-static int		ChanHandler(ClientData instanceData,
+static void		ZlibTransformWatch(ClientData instanceData, int mask);
+static int		ZlibTransformGetHandle(ClientData instanceData,
+			    int direction, ClientData *handlePtr);
+static int		ZlibTransformBlockMode(ClientData instanceData,
+			    int mode);
+static int		ZlibTransformHandler(ClientData instanceData,
 			    int interestMask);
-#endif
+static void		ZlibTransformTimerSetup(ZlibChannelData *cd);
+static void		ZlibTransformTimerKill(ZlibChannelData *cd);
+static void		ZlibTransformTimerRun(ClientData clientData);
 static void		ConvertError(Tcl_Interp *interp, int code);
 static void		ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj);
 static int		GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
@@ -155,42 +166,67 @@ static int		ZlibStreamCmd(ClientData cd, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 static void		ZlibStreamCmdDelete(ClientData cd);
 static void		ZlibStreamCleanup(ZlibStreamHandle *zshPtr);
-static Tcl_Channel	ZlibStackChannel(Tcl_Interp *interp, int mode,
-			    int format, int level, Tcl_Channel channel,
-			    Tcl_Obj *gzipHeaderDictPtr);
+static Tcl_Channel	ZlibStackChannelTransform(Tcl_Interp *interp,
+			    int mode, int format, int level,
+			    Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr);
 
-#ifdef _WIN32
-#   ifndef STATIC_BUILD
+/*
+ * Type of zlib-based compressing and decompressing channels.
+ */
 
+static const Tcl_ChannelType zlibChannelType = {
+    "zlib",
+    TCL_CHANNEL_VERSION_3,
+    ZlibTransformClose,
+    ZlibTransformInput,
+    ZlibTransformOutput,
+    NULL,			/* seekProc */
+    ZlibTransformSetOption,
+    ZlibTransformGetOption,
+    ZlibTransformWatch,
+    ZlibTransformGetHandle,
+    NULL,			/* close2Proc */
+    ZlibTransformBlockMode,
+    NULL,			/* flushProc */
+    ZlibTransformHandler,
+    NULL			/* wideSeekProc */
+};
+
 /*
  * zlib 1.2.3 on Windows has a bug that the functions deflateSetHeader and
- * inflateGetHeader are not exported from the dll. Hopefully, this bug
- * will be fixed in zlib 1.2.4 and higher. It is already reported to the
- * zlib people. The functions deflateSetHeader and inflateGetHeader here
- * are just copied from the zlib 1.2.3 source. This is dangerous, but works.
- * In practice, the only fields used from the internal state are "wrap" and
- * "head", which are rather at the beginning of the structure. As long as the
- * offsets of those fields don't change, this code will continue to work.
+ * inflateGetHeader are not exported from the dll. Hopefully, this bug will be
+ * fixed in zlib 1.2.4 and higher. It is already reported to the zlib people.
+ * The functions deflateSetHeader and inflateGetHeader here are just copied
+ * from the zlib 1.2.3 source. This is dangerous, but works. In practice, the
+ * only fields used from the internal state are "wrap" and "head", which are
+ * rather at the beginning of the structure. As long as the offsets of those
+ * fields don't change, this code will continue to work.
  */
+
+#if defined(_WIN32) && !defined(STATIC_BUILD)
 #define deflateSetHeader dsetheader
 #define inflateGetHeader igetheader
+
 static int
 deflateSetHeader(
     z_streamp strm,
     gz_headerp head)
 {
     struct internal_state *state;
+
     if (strm == Z_NULL) return Z_STREAM_ERROR;
     state = (struct internal_state *) strm->state;
     if ((state == Z_NULL) || (state->wrap != 2)) return Z_STREAM_ERROR;
     state->gzhead = head;
     return Z_OK;
 }
+
 static int inflateGetHeader(
     z_streamp strm,
     gz_headerp head)
 {
     struct inflate_state *state;
+
     if (strm == Z_NULL) return Z_STREAM_ERROR;
     state = (struct inflate_state *) strm->state;
     if ((state == Z_NULL) || ((state->wrap & 2) == 0)) return Z_STREAM_ERROR;
@@ -198,31 +234,8 @@ static int inflateGetHeader(
     head->done = 0;
     return Z_OK;
 }
-#   endif /* !STATIC_BUILD */
-#endif /* _WIN32 */
-
-/*
- * Type of zlib-based compressing and decompressing channels.
- */
-
-static const Tcl_ChannelType zlibChannelType = {
-    "zlib",
-    TCL_CHANNEL_VERSION_3,
-    ChanClose,
-    ChanInput,
-    ChanOutput,
-    NULL,			/* seekProc */
-    ChanSetOption,
-    ChanGetOption,
-    ChanWatch,
-    ChanGetHandle,
-    NULL,			/* close2Proc */
-    ChanBlockMode,
-    NULL,			/* flushProc */
-    NULL /*ChanHandler*/,
-    NULL			/* wideSeekProc */
-};
-
+#endif /* _WIN32 && !STATIC_BUILD */
+
 /*
  *----------------------------------------------------------------------
  *
@@ -277,7 +290,7 @@ ConvertError(
 	Tcl_SetErrorCode(interp, "TCL", "ZLIB", codeStr, codeStr2, NULL);
     }
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -398,7 +411,7 @@ GenerateHeader(
     Tcl_FreeEncoding(latin1enc);
     return result;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -489,7 +502,7 @@ ExtractHeader(
 	Tcl_FreeEncoding(latin1enc);
     }
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -680,7 +693,7 @@ Tcl_ZlibStreamInit(
     ckfree((char *) zshPtr);
     return TCL_ERROR;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -707,7 +720,7 @@ ZlibStreamCmdDelete(
     zshPtr->cmd = NULL;
     ZlibStreamCleanup(zshPtr);
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -745,7 +758,7 @@ Tcl_ZlibStreamClose(
     }
     return TCL_OK;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -787,7 +800,7 @@ ZlibStreamCleanup(
 
     ckfree((char *) zshPtr);
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -856,7 +869,7 @@ Tcl_ZlibStreamReset(
 
     return TCL_OK;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -890,7 +903,7 @@ Tcl_ZlibStreamGetCommandName(
     Tcl_GetCommandFullName(zshPtr->interp, zshPtr->cmd, objPtr);
     return objPtr;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -918,7 +931,7 @@ Tcl_ZlibStreamEof(
 
     return zshPtr->streamEnd;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -938,7 +951,7 @@ Tcl_ZlibStreamChecksum(
 
     return zshPtr->stream.adler;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -1046,7 +1059,7 @@ Tcl_ZlibStreamPut(
 
     return TCL_OK;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -1255,7 +1268,7 @@ Tcl_ZlibStreamGet(
     }
     return TCL_OK;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -1410,7 +1423,7 @@ Tcl_ZlibDeflate(
     ConvertError(interp, e);
     return TCL_ERROR;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -1597,7 +1610,7 @@ Tcl_ZlibInflate(
     }
     return TCL_ERROR;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -1626,7 +1639,7 @@ Tcl_ZlibAdler32(
 {
     return adler32(adler, (Bytef *) buf, (unsigned) len);
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -2033,7 +2046,7 @@ TclZlibCmd(
 	    }
 	}
 
-	if (ZlibStackChannel(interp, mode, format, level, chan,
+	if (ZlibStackChannelTransform(interp, mode, format, level, chan,
 		headerObj) == NULL) {
 	    return TCL_ERROR;
 	}
@@ -2054,7 +2067,7 @@ TclZlibCmd(
     Tcl_AppendResult(interp, "buffer size must be 32 to 65536", NULL);
     return TCL_ERROR;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -2276,7 +2289,7 @@ ZlibStreamCmd(
 
     return TCL_OK;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *	Set of functions to support channel stacking.
@@ -2284,13 +2297,14 @@ ZlibStreamCmd(
  */
 
 static int
-ChanClose(
+ZlibTransformClose(
     ClientData instanceData,
     Tcl_Interp *interp)
 {
     ZlibChannelData *cd = instanceData;
     int e, result = TCL_OK;
 
+    ZlibTransformTimerKill(cd);
     if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
 	cd->outStream.avail_in = 0;
 	do {
@@ -2336,7 +2350,7 @@ ChanClose(
 }
 
 static int
-ChanInput(
+ZlibTransformInput(
     ClientData instanceData,
     char *buf,
     int toRead,
@@ -2396,7 +2410,7 @@ ChanInput(
 }
 
 static int
-ChanOutput(
+ZlibTransformOutput(
     ClientData instanceData,
     const char *buf,
     int toWrite,
@@ -2440,7 +2454,7 @@ ChanOutput(
 }
 
 static int
-ChanSetOption(			/* not used */
+ZlibTransformSetOption(			/* not used */
     ClientData instanceData,
     Tcl_Interp *interp,
     const char *optionName,
@@ -2502,7 +2516,7 @@ ChanSetOption(			/* not used */
 }
 
 static int
-ChanGetOption(
+ZlibTransformGetOption(
     ClientData instanceData,
     Tcl_Interp *interp,
     const char *optionName,
@@ -2578,15 +2592,28 @@ ChanGetOption(
 }
 
 static void
-ChanWatch(
+ZlibTransformWatch(
     ClientData instanceData,
     int mask)
 {
-    return;
+    ZlibChannelData *cd = instanceData;
+    Tcl_DriverWatchProc *watchProc;
+
+    /*
+     * This code is based on the code in tclIORTrans.c
+     */
+
+    watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(cd->parent));
+    watchProc(Tcl_GetChannelInstanceData(cd->parent), mask);
+    if (!(mask & TCL_READABLE) || (cd->inStream.avail_in==cd->inAllocated)) {
+	ZlibTransformTimerKill(cd);
+    } else {
+	ZlibTransformTimerSetup(cd);
+    }
 }
 
 static int
-ChanGetHandle(
+ZlibTransformGetHandle(
     ClientData instanceData,
     int direction,
     ClientData *handlePtr)
@@ -2597,7 +2624,7 @@ ChanGetHandle(
 }
 
 static int
-ChanBlockMode(
+ZlibTransformBlockMode(
     ClientData instanceData,
     int mode)
 {
@@ -2611,24 +2638,51 @@ ChanBlockMode(
     return TCL_OK;
 }
 
-#if 0 /* unused */
 static int
-ChanHandler(
+ZlibTransformHandler(
     ClientData instanceData,
     int interestMask)
 {
-    /*
-     * We don't handle this here. Assume it came from the underlying channel.
-     */
+    ZlibChannelData *cd = instanceData;
 
+    ZlibTransformTimerKill(cd);
     return interestMask;
 }
-#endif
 
+static void
+ZlibTransformTimerSetup(
+    ZlibChannelData *cd)
+{
+    if (cd->timer == NULL) {
+	cd->timer = Tcl_CreateTimerHandler(TRANSFORM_FLUSH_DELAY,
+		ZlibTransformTimerRun, cd);
+    }
+}
+
+static void
+ZlibTransformTimerKill(
+    ZlibChannelData *cd)
+{
+    if (cd->timer != NULL) {
+	Tcl_DeleteTimerHandler(cd->timer);
+	cd->timer = NULL;
+    }
+}
+
+static void
+ZlibTransformTimerRun(
+    ClientData clientData)
+{
+    ZlibChannelData *cd = clientData;
+
+    cd->timer = NULL;
+    Tcl_NotifyChannel(cd->chan, TCL_READABLE);
+}
+
 /*
  *----------------------------------------------------------------------
  *
- * ZlibStackChannel --
+ * ZlibStackChannelTransform --
  *
  *	Stacks either compression or decompression onto a channel.
  *
@@ -2639,7 +2693,7 @@ ChanHandler(
  */
 
 static Tcl_Channel
-ZlibStackChannel(
+ZlibStackChannelTransform(
     Tcl_Interp *interp,		/* Where to write error messages. */
     int mode,			/* Whether this is a compressing transform
 				 * (TCL_ZLIB_STREAM_DEFLATE) or a
@@ -2745,6 +2799,7 @@ ZlibStackChannel(
     if (chan == NULL) {
 	goto error;
     }
+    cd->chan = chan;
     cd->parent = Tcl_GetStackedChannel(chan);
     Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
     return chan;
@@ -2761,7 +2816,7 @@ ZlibStackChannel(
     ckfree((char *) cd);
     return NULL;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *	Finally, the TclZlibInit function. Used to install the zlib API.
@@ -2787,7 +2842,7 @@ TclZlibInit(
     Tcl_CreateObjCommand(interp, "zlib", TclZlibCmd, 0, 0);
     return TCL_OK;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *	Stubs used when a suitable zlib installation was not found during
@@ -2904,7 +2959,7 @@ Tcl_ZlibAdler32(
     return 0;
 }
 #endif /* HAVE_ZLIB */
-
+
 /*
  * Local Variables:
  * mode: c
diff --git a/tests/zlib.test b/tests/zlib.test
index 41599a6..dae1861 100644
--- a/tests/zlib.test
+++ b/tests/zlib.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: zlib.test,v 1.7 2009/03/04 17:26:24 dkf Exp $
+# RCS: @(#) $Id: zlib.test,v 1.8 2009/07/05 16:05:59 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -130,6 +130,34 @@ test zlib-8.2 {zlib transformation} -constraints zlib -setup {
     close $f
     removeFile $file
 } -result ok
+test zlib-8.3 {zlib transformation and fileevent} -constraints zlib -setup {
+    set srv [socket -myaddr localhost -server {apply {{c a p} {
+        fconfigure $c -translation binary
+        puts -nonewline $c [zlib gzip [string repeat a 81920]]
+        close $c
+    }}} 0]
+    set port [lindex [fconfigure $srv -sockname] 2]
+    set file [makeFile {} test.gz]
+    set fout [open $file wb]
+} -body {
+    set sin [socket localhost $port]
+    try {
+	fconfigure $sin -translation binary
+	zlib push gunzip $sin
+	after 1000 {set total timeout}
+	fcopy $sin $fout -command {apply {{c {e {}}} {
+	    set ::total [expr {$e eq {} ? $c : $e}]
+	}}}
+	vwait total
+    } finally {
+	close $sin
+    }
+    append total --> [file size $file]
+} -cleanup {
+    close $fout
+    close $srv
+    removeFile $file
+} -result 81920-->81920
 
 ::tcltest::cleanupTests
 return