* generic/tclIO.c (CopyData): Applied another patch by Alexandre

	* io.test (io-53.8a): Ferrieux <ferrieux@users.sourceforge.net>,
	* chanio.test (chan-io-53.8a): to shift EOF handling to the async
	part of the command if a callback is specified, should the channel
	be at EOF already when fcopy is called. Testcase by myself.


FossilOrigin-Name: f8664c06387f7e8f582710632ba93af81612df98

4 files changed, 98 insertions, 8 deletions

diff --git a/ChangeLog b/ChangeLog
index 819a25e..57dbc3d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2008-04-15  Andreas Kupries  <andreask@activestate.com>
+
+	* generic/tclIO.c (CopyData): Applied another patch by Alexandre
+	* io.test (io-53.8a): Ferrieux <ferrieux@users.sourceforge.net>,
+	* chanio.test (chan-io-53.8a): to shift EOF handling to the async
+	part of the command if a callback is specified, should the channel
+	be at EOF already when fcopy is called. Testcase by myself.
+
 2008-04-15  Daniel Steffen  <das@users.sourceforge.net>
 
 	* unix/Makefile.in:	adjust tclDTrace.h dependencies for removal
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 2b6138c..1d917ba 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.141 2008/04/07 22:53:08 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.142 2008/04/15 18:34:47 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -8641,15 +8641,17 @@ CopyData(
 	    break;
 	} else if (underflow) {
 	    /*
-	     * We had an underflow on the read side. If we are at EOF, then
-	     * the copying is done, otherwise set up a channel handler to
-	     * detect when the channel becomes readable again.
+	     * We had an underflow on the read side. If we are at EOF, and not
+	     * in the synchronous part of an asynchronous fcopy, then the
+	     * copying is done, otherwise set up a channel handler to detect
+	     * when the channel becomes readable again.
 	     */
 
-	    if ((size == 0) && Tcl_Eof(inChan)) {
+	    if ((size == 0) && Tcl_Eof(inChan) && !(cmdPtr && (mask == 0))) {
 		break;
 	    }
-	    if (! Tcl_Eof(inChan) && !(mask & TCL_READABLE)) {
+	    if (((!Tcl_Eof(inChan)) || (cmdPtr && (mask == 0))) &&
+		!(mask & TCL_READABLE)) {
 		if (mask & TCL_WRITABLE) {
 		    Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);
 		}
diff --git a/tests/chanio.test b/tests/chanio.test
index 6ac7dbb..e79cb97 100644
--- a/tests/chanio.test
+++ b/tests/chanio.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: chanio.test,v 1.10 2008/04/10 20:58:59 andreas_kupries Exp $
+# RCS: @(#) $Id: chanio.test,v 1.11 2008/04/15 18:34:48 andreas_kupries Exp $
 
 if {[catch {package require tcltest 2}]} {
     chan puts stderr "Skipping tests in [info script].  tcltest 2 required."
@@ -6967,6 +6967,46 @@ test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -se
     removeFile foo
     removeFile bar
 } -result {0 sync/OK 0 {CMD 2} {bgerror/OK !STOP}}
+test chan-io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof} -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] ; chan configure $f -translation binary
+    set g [open $bar w] ; chan configure $g -translation binary -buffering none
+} -constraints {stdio openpipe fcopy} -body {
+    # Initialize and force eof on the input.
+    chan seek $f 0 end ; chan read $f 1
+    set ::RES [chan eof $f]
+    # Run the copy. Should not invoke -command now.
+    chan copy $f $g -size 2 -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 {
+    chan close $f
+    chan close $g
+    catch {unset ::RES}
+    catch {unset ::forever}
+    rename ::cmd {}
+    removeFile foo
+    removeFile bar
+} -result {1 sync/OK {CMD 0}}
 test chan-io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup {
     set out [makeFile {} out]
     set err [makeFile {} err]
diff --git a/tests/io.test b/tests/io.test
index 3dd5bbf..e03fa8a 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.87 2008/04/10 20:58:59 andreas_kupries Exp $
+# RCS: @(#) $Id: io.test,v 1.88 2008/04/15 18:34:48 andreas_kupries Exp $
 
 if {[catch {package require tcltest 2}]} {
     puts stderr "Skipping tests in [info script].  tcltest 2 required."
@@ -6967,6 +6967,46 @@ test io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup {
     removeFile foo
     removeFile bar
 } -result {0 sync/OK 0 {CMD 2} {bgerror/OK !STOP}}
+test io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof} -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 {
+    # Initialize and force eof on the input.
+    seek $f 0 end ; read $f 1
+    set ::RES [eof $f]
+    # Run the copy. Should not invoke -command now.
+    fcopy $f $g -size 2 -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 {1 sync/OK {CMD 0}}
 test io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup {
     set out [makeFile {} out]
     set err [makeFile {} err]