diff options
Diffstat (limited to 'tests/io.test')
| -rw-r--r-- | tests/io.test | 37 |
1 files changed, 36 insertions, 1 deletions
diff --git a/tests/io.test b/tests/io.test index 07d96a5..648f5e7 100644 --- a/tests/io.test +++ b/tests/io.test @@ -12,7 +12,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.36 2002/07/10 11:56:44 dgp Exp $ +# RCS: @(#) $Id: io.test,v 1.37 2002/07/30 18:36:26 andreas_kupries Exp $ if {[catch {package require tcltest 2}]} { puts stderr "Skipping tests in [info script]. tcltest 2 required." @@ -7077,6 +7077,41 @@ test io-59.1 {Thread reference of channels} {testmainthread testchannel} { string equal $result [testmainthread] } {1} + +test io-60.1 {writing illegal utf sequences} { + # This test will hang in older revisions of the core. + + set out [open $path(script) w] + puts $out { + puts [encoding convertfrom identity \xe2] + exit 1 + } + proc readit {pipe} { + variable x + variable result + if {[eof $pipe]} { + set x [catch {close $pipe} line] + lappend result catch $line + } else { + gets $pipe line + lappend result gets $line + } + } + close $out + set pipe [open "|[list [interpreter] $path(script)]" r] + fileevent $pipe readable [namespace code [list readit $pipe]] + variable x "" + set result "" + vwait [namespace which -variable x] + + # cut of the remainder of the error stack, especially the filename + set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]] + list $x $result +} {1 {gets {} catch {error writing "stdout": invalid argument}}} + + + + # cleanup foreach file [list fooBar longfile script output test1 pipe my_script foo \ bar test2 test3 cat stdout] { |