Tcl Source Code

Artifact [6fbcc1302b]
Login

Artifact 6fbcc1302ba213140d309acc63cdbb3553767ee7:

Attachment "encoding-474358-219314-524674.patch" to ticket [474358ffff] added by hobbs 2002-03-05 04:59:22.
Index: generic/tclEncoding.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclEncoding.c,v
retrieving revision 1.10
diff -b -u -r1.10 tclEncoding.c
--- generic/tclEncoding.c	8 Feb 2002 02:52:54 -0000	1.10
+++ generic/tclEncoding.c	4 Mar 2002 21:52:19 -0000
@@ -310,18 +310,16 @@
 {
     Tcl_HashSearch search;
     Tcl_HashEntry *hPtr;
-    Encoding *encodingPtr;
 
     Tcl_MutexLock(&encodingMutex);
     encodingsInitialized  = 0;
     hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
     while (hPtr != NULL) {
-	encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
-	if (encodingPtr->freeProc != NULL) {
-	    (*encodingPtr->freeProc)(encodingPtr->clientData);
-	}
-	ckfree((char *) encodingPtr->name);
-	ckfree((char *) encodingPtr);
+	/*
+	 * Call FreeEncoding instead of doing it directly to handle refcounts
+	 * like escape encodings use.  [Bug #524674]
+	 */
+	FreeEncoding((Tcl_Encoding) Tcl_GetHashValue(hPtr));
 	hPtr = Tcl_NextHashEntry(&search);
     }
     Tcl_DeleteHashTable(&encodingTable);
@@ -2206,6 +2204,10 @@
 {
     TableEncodingData *dataPtr;
 
+    /*
+     * Make sure we aren't freeing twice on shutdown.  [Bug #219314]
+     */
+
     dataPtr = (TableEncodingData *) clientData;
     ckfree((char *) dataPtr->toUnicode);
     ckfree((char *) dataPtr->fromUnicode);
@@ -2491,12 +2493,14 @@
     dstStart = dst;
     dstEnd = dst + dstLen - 1;
 
-    if (flags & TCL_ENCODING_START) {
-	unsigned int len;
+    /*
+     * RFC1468 states that the text starts in ASCII, and switches to Japanese
+     * characters, and that the text must end in ASCII. [Patch #474358]
+     */
 	
+    if (flags & TCL_ENCODING_START) {
 	state = 0;
-	len = dataPtr->subTables[0].sequenceLen;
-	if (dst + dataPtr->initLen + len > dstEnd) {
+	if (dst + dataPtr->initLen > dstEnd) {
 	    *srcReadPtr = 0;
 	    *dstWrotePtr = 0;
 	    return TCL_CONVERT_NOSPACE;
@@ -2504,9 +2508,6 @@
 	memcpy((VOID *) dst, (VOID *) dataPtr->init,
 		(size_t) dataPtr->initLen);
 	dst += dataPtr->initLen;
-	memcpy((VOID *) dst, (VOID *) dataPtr->subTables[0].sequence,
-		(size_t) len);
-	dst += len;
     } else {
         state = (int) *statePtr;
     }
@@ -2591,9 +2592,15 @@
     }
 
     if ((result == TCL_OK) && (flags & TCL_ENCODING_END)) {
-	if (dst + dataPtr->finalLen > dstEnd) {
+	unsigned int len = dataPtr->subTables[0].sequenceLen;
+	if (dst + dataPtr->finalLen + (state?len:0) > dstEnd) {
 	    result = TCL_CONVERT_NOSPACE;
 	} else {
+	    if (state) {
+		memcpy((VOID *) dst, (VOID *) dataPtr->subTables[0].sequence,
+			(size_t) len);
+		dst += len;
+	    }
 	    memcpy((VOID *) dst, (VOID *) dataPtr->final,
 		    (size_t) dataPtr->finalLen);
 	    dst += dataPtr->finalLen;
Index: tests/encoding.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/encoding.test,v
retrieving revision 1.9
diff -b -u -r1.9 encoding.test
--- tests/encoding.test	2 Mar 2002 04:55:31 -0000	1.9
+++ tests/encoding.test	4 Mar 2002 21:52:19 -0000
@@ -199,7 +199,7 @@
 proc viewable {str} {
     set res ""
     foreach c [split $str {}] {
-	if {[string is print $c]} {
+	if {[string is print $c] && [string is ascii $c]} {
 	    append res $c
 	} else {
 	    append res "\\u[format %4.4x [scan $c %c]]"
@@ -229,10 +229,10 @@
 } "\u4e4e"
 test encoding-11.5 {LoadEncodingFile: escape file} {
     viewable [encoding convertto iso2022 \u4e4e]
-} [viewable "\x1b(B\x1b\$B8C"]
+} [viewable "\x1b\$B8C\x1b(B"]
 test encoding-11.5.1 {LoadEncodingFile: escape file} {
     viewable [encoding convertto iso2022-jp \u4e4e]
-} [viewable "\x1b(B\x1b\$B8C"]
+} [viewable "\x1b\$B8C\x1b(B"]
 test encoding-11.6 {LoadEncodingFile: invalid file} {testencoding} {
     set system [encoding system]
     set path [testencoding path]
@@ -278,7 +278,7 @@
 
 test encoding-13.1 {LoadEscapeTable} {
     viewable [set x [encoding convertto iso2022 ab\u4e4e\u68d9g]]
-} [viewable "\x1b(Bab\x1b\$B8C\x1b\$\(DD%\x1b(Bg"]
+} [viewable "ab\x1b\$B8C\x1b\$\(DD%\x1b(Bg"]
 
 test encoding-14.1 {BinaryProc} {
     encoding convertto identity \x12\x34\x56\xff\x69
@@ -361,7 +361,49 @@
     set data
 } [string range $::iso2022uniData 0 49] ; # 0 .. 49 inclusive == 50
 
+test encoding-24.1 {EscapeFreeProc on open channels} {
+    # Bug #524674 input
+    set f [open iso2022.tcl w]
+    puts $f {
+	set f [open iso2022.txt]
+	fconfigure $f -encoding iso2022-jp
+	gets $f
+    }
+    close $f
+    exec [list $::tcltest::tcltest] iso2022.tcl
+} {}
+
+test encoding-24.2 {EscapeFreeProc on open channels} {
+    # Bug #524674 output
+    set f [open iso2022.tcl w]
+    puts $f {
+	fconfigure stdout -encoding iso2022-jp
+	puts ab\u4e4e\u68d9g
+	exit
+    }
+    close $f
+    viewable [exec [list $::tcltest::tcltest] iso2022.tcl]
+} "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)"
+
+test encoding-24.3 {EscapeFreeProc on open channels} {
+    # Bug #219314 - if we don't free escape encodings correctly on
+    # channel closure, we go boom
+    set f [open iso2022.tcl w]
+    puts $f {
+	encoding system iso2022-jp
+	set a "\u4e4e\u4e5e\u4e5f"; # 3 Japanese Kanji letters
+	puts $a
+    }
+    close $f
+    set f [open "|[list $::tcltest::tcltest iso2022.tcl]"]
+    fconfigure $f -encoding iso2022-jp
+    set count [gets $f line]
+    close $f
+    list $count [viewable $line]
+} [list 3 "\u4e4e\u4e5e\u4e5f (\\u4e4e\\u4e5e\\u4e5f)"]
+
 ::tcltest::removeFile iso2022.txt
+::tcltest::removeFile iso2022.tcl
 
 # EscapeFreeProc, GetTableEncoding, unilen
 # are fully tested by the rest of this file