summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2014-07-24 15:17:19 (GMT)
committerdgp <dgp@users.sourceforge.net>2014-07-24 15:17:19 (GMT)
commit103265bd2b0e08ddb0c3d1fa280411f904f3490b (patch)
treeb56df3eef7c567e94dcbb86d2ecdb21a5cb63279
parent36ec4e104487d2d718dc0a62e145afa4bdfecafc (diff)
downloadtcl-103265bd2b0e08ddb0c3d1fa280411f904f3490b.zip
tcl-103265bd2b0e08ddb0c3d1fa280411f904f3490b.tar.gz
tcl-103265bd2b0e08ddb0c3d1fa280411f904f3490b.tar.bz2
Test format of write error messages during binary [chan copy]
-rw-r--r--tests/io.test30
1 files changed, 30 insertions, 0 deletions
diff --git a/tests/io.test b/tests/io.test
index b707c01..cef3e81 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -7642,6 +7642,36 @@ test io-53.13 {TclCopyChannel: read error reporting} -setup {
removeFile out
rename driver {}
} -result {error reading "*": *} -returnCodes error -match glob
+test io-53.14 {TclCopyChannel: write error reporting} -setup {
+ proc driver {cmd args} {
+ variable buffer
+ variable index
+ set chan [lindex $args 0]
+ switch -- $cmd {
+ initialize {
+ return {initialize finalize watch write}
+ }
+ finalize {
+ return
+ }
+ watch {}
+ write {
+ error FAIL
+ }
+ }
+ }
+ set inFile [makeFile {aaa} in]
+} -body {
+ set in [open $inFile rb]
+ set out [chan create write [namespace which driver]]
+ chan configure $out -translation binary
+ chan copy $in $out
+} -cleanup {
+ catch {close $in}
+ catch {close $out}
+ removeFile in
+ rename driver {}
+} -result {error writing "*": *} -returnCodes error -match glob
test io-54.1 {Recursive channel events} {socket fileevent} {
# This test checks to see if file events are delivered during recursive