diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | generic/tclIO.c | 18 | ||||
| -rw-r--r-- | tests/io.test | 37 |
3 files changed, 62 insertions, 3 deletions
@@ -1,3 +1,13 @@ +2002-07-30 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * 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. + 2002-07-29 Mo DeJong <mdejong@users.sourceforge.net> * unix/Makefile.in: Use CC_SEARCH_FLAGS instead of diff --git a/generic/tclIO.c b/generic/tclIO.c index 4895824..912a651 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIO.c,v 1.56 2002/05/24 21:19:05 dkf Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.57 2002/07/30 18:36:25 andreas_kupries Exp $ */ #include "tclInt.h" @@ -3055,6 +3055,7 @@ WriteChars(chanPtr, src, srcLen) char *dst, *stage; int saved, savedLF, sawLF, total, dstLen, stageMax, dstWrote; int stageLen, toWrite, stageRead, endEncoding, result; + int consumedSomething; Tcl_Encoding encoding; char safe[BUFFER_PADDING]; @@ -3075,7 +3076,9 @@ WriteChars(chanPtr, src, srcLen) * with proper EOL translation. */ - while (srcLen + savedLF + endEncoding > 0) { + consumedSomething = 1; + while (consumedSomething && (srcLen + savedLF + endEncoding > 0)) { + consumedSomething = 0; stage = statePtr->outputStage; stageMax = statePtr->bufSize; stageLen = stageMax; @@ -3199,6 +3202,8 @@ WriteChars(chanPtr, src, srcLen) stageLen -= stageRead; sawLF = 0; + consumedSomething = 1; + /* * If all translated characters are written to the buffer, * endEncoding is set to 0 because the escape sequence may be @@ -3210,6 +3215,15 @@ WriteChars(chanPtr, src, srcLen) } } } + + /* If nothing was written and it happened because there was no progress + * in the UTF conversion, we throw an error. + */ + + if (!consumedSomething && (total == 0)) { + Tcl_SetErrno (EINVAL); + return -1; + } return total; } 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] { |