diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclIO.c | 39 | ||||
| -rw-r--r-- | tests/io.test | 40 |
3 files changed, 82 insertions, 2 deletions
@@ -1,3 +1,8 @@ +2010-12-10 Alexandre Ferrieux <ferrieux@users.sourceforge.net> + + * generic/tclIO.c: Make sure [fcopy -size ... -command ...] always + * tests/io.test: calls the callback asynchronously, even for size zero. + 2010-12-10 Jan Nijtmans <nijtmans@users.sf.net> * generic/tclBinary.c: Fix gcc -Wextra warning: missing initializer diff --git a/generic/tclIO.c b/generic/tclIO.c index 0ed57d0..adc630f 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.175 2010/03/20 17:49:15 dkf Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.176 2010/12/10 17:00:12 ferrieux Exp $ */ #include "tclInt.h" @@ -8915,6 +8915,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 @@ -9033,6 +9060,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 c69bff9..e2d0c13 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.96 2010/02/07 08:03:11 dkf Exp $ +# RCS: @(#) $Id: io.test,v 1.97 2010/12/10 17:00:12 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] |