Attachment "584603.diff" to
ticket [584603ffff]
added by
andreas_kupries
2002-07-24 07:16:27.
? generic/tclMain.c.ano
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.1171
diff -u -r1.1171 ChangeLog
--- ChangeLog 23 Jul 2002 18:37:53 -0000 1.1171
+++ ChangeLog 24 Jul 2002 00:14:52 -0000
@@ -1,3 +1,13 @@
+2002-07-23 Andreas Kupries <[email protected]>
+
+ * 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-23 Joe English <[email protected]>
* doc/OpenFileChnl.3: (Updates from Larry Virden)
Index: generic/tclIO.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIO.c,v
retrieving revision 1.56
diff -u -r1.56 tclIO.c
--- generic/tclIO.c 24 May 2002 21:19:05 -0000 1.56
+++ generic/tclIO.c 24 Jul 2002 00:14:52 -0000
@@ -3055,6 +3055,7 @@
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 @@
* 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 @@
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
@@ -3209,6 +3214,15 @@
endEncoding = 0;
}
}
+ }
+
+ /* 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;
}
Index: tests/io.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/io.test,v
retrieving revision 1.36
diff -u -r1.36 io.test
--- tests/io.test 10 Jul 2002 11:56:44 -0000 1.36
+++ tests/io.test 24 Jul 2002 00:14:53 -0000
@@ -7077,6 +7077,41 @@
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] {
