* tests/io.test:

	* generic/tclIO.c (WriteChars): Added flag to break out of loop if
	  nothing of the input is consumed at all, to prevent infinite
	  looping of called with a non-UTF-8 string. Fixes Bug 584603
	  (partially). Added new test "io-60.1". Might need additional
	  changes to Tcl_Main so that unprintable results are printed as
	  binary data.

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] {