summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorandreas_kupries <akupries@shaw.ca>2002-07-30 18:36:23 (GMT)
committerandreas_kupries <akupries@shaw.ca>2002-07-30 18:36:23 (GMT)
commitede11f1fcc9723dfd791f6be7b43a0a11cc21ac6 (patch)
treef50ccaf9d490d3fba5dd9422468410b8030fc442 /tests
parent709c9e7193e7f6e1840a798149b76b33f47ccffa (diff)
downloadtcl-ede11f1fcc9723dfd791f6be7b43a0a11cc21ac6.zip
tcl-ede11f1fcc9723dfd791f6be7b43a0a11cc21ac6.tar.gz
tcl-ede11f1fcc9723dfd791f6be7b43a0a11cc21ac6.tar.bz2
* 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.
Diffstat (limited to 'tests')
-rw-r--r--tests/io.test37
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] {