summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclIO.c39
-rw-r--r--tests/io.test40
3 files changed, 82 insertions, 2 deletions
diff --git a/ChangeLog b/ChangeLog
index 76cb2fb..87226e4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2010-12-10 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclIO.c: [backport] Make sure [fcopy -size ... -command ...] always
+ * tests/io.test: calls the callback asynchronously, even for size zero.
+
2010-12-03 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tclUtil.c (TclReToGlob): add extra check for multiple
diff --git a/generic/tclIO.c b/generic/tclIO.c
index ebbb3d1..1bd4cdd 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -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: tclIO.c,v 1.137.2.17 2010/03/20 17:53:07 dkf Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.137.2.18 2010/12/10 17:16:08 ferrieux Exp $
*/
#include "tclInt.h"
@@ -8467,6 +8467,33 @@ Tcl_FileEventObjCmd(
/*
*----------------------------------------------------------------------
*
+ * ZeroTransferTimerProc --
+ *
+ * Timer handler scheduled by TclCopyChannel so that -command is
+ * called asynchronously even when -size is 0.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Calls CopyData for -command invocation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ZeroTransferTimerProc(
+ ClientData clientData)
+{
+ /* calling CopyData with mask==0 still implies immediate invocation of the
+ * -command callback, and completion of the fcopy.
+ */
+ CopyData(clientData, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCopyChannel --
*
* This routine copies data from one channel to another, either
@@ -8573,6 +8600,16 @@ TclCopyChannel(
outStatePtr->csPtrW = csPtr;
/*
+ * Special handling of -size 0 async transfers, so that the -command is
+ * still called asynchronously.
+ */
+
+ if ((nonBlocking == CHANNEL_NONBLOCKING) && (toRead == 0)) {
+ Tcl_CreateTimerHandler(0, ZeroTransferTimerProc, csPtr);
+ return 0;
+ }
+
+ /*
* Start copying data between the channels.
*/
diff --git a/tests/io.test b/tests/io.test
index 06e0ecc..5449a0d 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -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: io.test,v 1.80.2.14 2009/11/12 15:47:20 dgp Exp $
+# RCS: @(#) $Id: io.test,v 1.80.2.15 2010/12/10 17:16:08 ferrieux Exp $
if {[catch {package require tcltest 2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2 required."
@@ -7007,6 +7007,44 @@ test io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof}
removeFile foo
removeFile bar
} -result {1 sync/OK {CMD 0}}
+test io-53.8b {CopyData: async callback and -size 0} -setup {
+ # copy progress callback. errors out intentionally
+ proc ::cmd args {
+ lappend ::RES "CMD $args"
+ set ::forever has-been-reached
+ return
+ }
+ # Files we use for our channels
+ set foo [makeFile ashgdfashdgfasdhgfasdhgf foo]
+ set bar [makeFile {} bar]
+ # Channels to copy between
+ set f [open $foo r] ; fconfigure $f -translation binary
+ set g [open $bar w] ; fconfigure $g -translation binary -buffering none
+} -constraints {stdio openpipe fcopy} -body {
+ set ::RES {}
+ # Run the copy. Should not invoke -command now.
+ fcopy $f $g -size 0 -command ::cmd
+ # Check that -command was not called synchronously
+ lappend ::RES [expr {([llength $::RES] > 1) ? "sync/FAIL" : "sync/OK"}]
+ # Now let the async part happen. Should capture the eof in cmd
+ # If not break the event loop via timer.
+ set token [after 1000 {
+ lappend ::RES {cmd/FAIL timeout}
+ set ::forever has-been-reached
+ }]
+ vwait ::forever
+ catch {after cancel $token}
+ # Report
+ set ::RES
+} -cleanup {
+ close $f
+ close $g
+ catch {unset ::RES}
+ catch {unset ::forever}
+ rename ::cmd {}
+ removeFile foo
+ removeFile bar
+} -result {sync/OK {CMD 0}}
test io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup {
set out [makeFile {} out]
set err [makeFile {} err]