* 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, 16 insertions, 2 deletions

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;
 }