9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
-
+
|
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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.8 2008/04/10 20:55:27 andreas_kupries Exp $
# RCS: @(#) $Id: io.test,v 1.80.2.9 2008/04/15 18:32:04 andreas_kupries Exp $
if {[catch {package require tcltest 2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2 required."
return
}
namespace eval ::tcl::test::io {
namespace import ::tcltest::*
|
6963
6964
6965
6966
6967
6968
6969
6970
6971
6972
6973
6974
6975
6976
|
6963
6964
6965
6966
6967
6968
6969
6970
6971
6972
6973
6974
6975
6976
6977
6978
6979
6980
6981
6982
6983
6984
6985
6986
6987
6988
6989
6990
6991
6992
6993
6994
6995
6996
6997
6998
6999
7000
7001
7002
7003
7004
7005
7006
7007
7008
7009
7010
7011
7012
7013
7014
7015
7016
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
catch {unset ::RES}
catch {unset ::forever}
rename ::cmd {}
rename ::bgerror {}
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]
set pipe [open "|[list [info nameofexecutable] 2> $err]" r+]
fconfigure $pipe -translation binary -buffering line
puts $pipe {
fconfigure stdout -translation binary -buffering line
|