summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorandreas_kupries <akupries@shaw.ca>2008-04-15 18:31:00 (GMT)
committerandreas_kupries <akupries@shaw.ca>2008-04-15 18:31:00 (GMT)
commitbc5dab9966108ba8082e389fc4a42e060cce440e (patch)
tree47b7f0cb5e199796391f1815fe3338f47f492d86
parentc8c10de926e7c958c17e8898fc18d2ca1ad50cf7 (diff)
downloadtcl-bc5dab9966108ba8082e389fc4a42e060cce440e.zip
tcl-bc5dab9966108ba8082e389fc4a42e060cce440e.tar.gz
tcl-bc5dab9966108ba8082e389fc4a42e060cce440e.tar.bz2
* generic/tclIO.c (CopyData): Applied another patch by Alexandre
* io.test (io-53.8a): Ferrieux <ferrieux@users.sourceforge.net>, 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.
-rw-r--r--ChangeLog8
-rw-r--r--generic/tclIO.c15
-rw-r--r--tests/io.test42
-rw-r--r--tests/ioCmd.test3
4 files changed, 60 insertions, 8 deletions
diff --git a/ChangeLog b/ChangeLog
index cf3cd7e..05200d5 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>,
+ 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-14 Kevin B. Kenny <kennykb@acm.org>
*** 8.4.19 TAGGED FOR RELEASE ***
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 3f79021..6502215 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.61.2.27 2008/04/07 22:17:37 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.61.2.28 2008/04/15 18:31:01 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -7887,15 +7887,18 @@ CopyData(csPtr, mask)
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,
(ClientData) csPtr);
diff --git a/tests/io.test b/tests/io.test
index 519959a..00c0a55 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.40.2.19 2008/04/10 20:53:49 andreas_kupries Exp $
+# RCS: @(#) $Id: io.test,v 1.40.2.20 2008/04/15 18:31:03 andreas_kupries Exp $
if {[catch {package require tcltest 2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2 required."
@@ -6999,6 +6999,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]
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index aa7fd1e..f4d45e4 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.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: ioCmd.test,v 1.16.2.5 2008/04/10 20:53:49 andreas_kupries Exp $
+# RCS: @(#) $Id: ioCmd.test,v 1.16.2.6 2008/04/15 18:31:04 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -578,6 +578,7 @@ test iocmd-15.12 {Tcl_FcopyObjCmd} {fcopy} {
list [catch {fcopy $rfile $wfile -command bar -size foo} msg] $msg
} {1 {expected integer but got "foo"}}
+
close $rfile
close $wfile