From 28a15ce481fd0e4b90f5904a64c80aa1d4266c97 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 15 Jun 2023 15:44:04 +0000
Subject: TIP #653 implementation (with a lot of corrections compared to the
 py-b8f575aa23 or the other tip-653 branch)

---
 generic/tclIOCmd.c |  5 ++++-
 tests/io.test      | 33 +++++++++++++++++----------------
 2 files changed, 21 insertions(+), 17 deletions(-)

diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 5a0a8da..f93f11e 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -459,7 +459,9 @@ Tcl_ReadObjCmd(
     TclChannelPreserve(chan);
     charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
     if (charactersRead == TCL_IO_FAILURE) {
-	Tcl_DecrRefCount(resultPtr);
+	Tcl_Obj *returnOptsPtr = Tcl_NewDictObj();
+	Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-data", -1),
+		resultPtr);
 	/*
 	 * TIP #219.
 	 * Capture error messages put by the driver into the bypass area and
@@ -473,6 +475,7 @@ Tcl_ReadObjCmd(
 		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));
 	}
 	TclChannelRelease(chan);
+	Tcl_SetReturnOptions(interp, returnOptsPtr);
 	return TCL_ERROR;
     }
 
diff --git a/tests/io.test b/tests/io.test
index 54ccaac..bc03656 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -9208,12 +9208,13 @@ test io-75.7 {
     fconfigure $f -encoding utf-8 -buffering none -eofchar {} -translation lf \
 	    -profile strict
 } -body {
-    list [catch {read $f} msg] $msg
+    list [catch {read $f} msg data] $msg [dict get $data -data]
 } -cleanup {
     close $f
     removeFile io-75.7
+    unset msg data
 } -match glob -result {1 {error reading "file*":\
-    invalid or incomplete multibyte or wide character}}
+    invalid or incomplete multibyte or wide character} A}
 
 test io-75.8 {invalid utf-8 encoding eof handling (-profile strict)} -setup {
     set fn [makeFile {} io-75.8]
@@ -9249,18 +9250,17 @@ test io-75.8.eoflater {invalid utf-8 encoding eof handling (-profile strict)} -s
     fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
 	-translation lf -profile strict
 } -body {
-    set res [list [catch {read $f} cres] [eof $f]]
+    set res [list [catch {read $f} msg data] [eof $f] [dict get $data -data]]
     chan configure $f -encoding iso8859-1
     lappend res [read $f 1]
     chan configure $f -encoding utf-8
-    catch {read $f 1} cres
-    lappend res $cres
+    lappend res [catch {read $f 1} msg data] $msg [dict get $data -data]
     close $f
     set res
 } -cleanup {
     removeFile io-75.8
-} -match glob -result "1 0 \x81 {error reading \"*\":\
-    invalid or incomplete multibyte or wide character}"
+} -match glob -result "1 0 A \x81 1 {error reading \"*\":\
+    invalid or incomplete multibyte or wide character} {}"
 
 
 test io-strict-multibyte-eof {
@@ -9268,7 +9268,6 @@ test io-strict-multibyte-eof {
 
     See issue 25cdcb7e8fb381fb
 } -setup {
-    set res {}
     set chan [file tempfile];
     fconfigure $chan -encoding binary
     puts -nonewline $chan \x81\x1A
@@ -9276,12 +9275,12 @@ test io-strict-multibyte-eof {
     seek $chan 0
     chan configure $chan -encoding utf-8 -profile strict
 } -body {
-    list [catch {read $chan 1} cres] $cres
+    list [catch {read $chan 1} msg data] $msg [dict get $data -data]
 } -cleanup {
     close $chan
-    unset res
+    unset msg data
 } -match glob -result {1 {error reading "*":\
-    invalid or incomplete multibyte or wide character}}
+    invalid or incomplete multibyte or wide character} {}}
 
 test io-75.9 {unrepresentable character write passes and is replaced by ?} -setup {
     set fn [makeFile {} io-75.9]
@@ -9336,12 +9335,13 @@ test io-75.11 {shiftjis encoding error read results in raw bytes} -setup {
 } -body {
     set d [read $f]
     binary scan $d H* hd
-    lappend hd [catch {set d [read $f]} msg] $msg
+    lappend hd [catch {set d [read $f]} msg data] $msg [dict get $data -data]
 } -cleanup {
     close $f
     removeFile io-75.11
+    unset d hd msg data
 } -match glob -result {41 1 {error reading "file*":\
-    invalid or incomplete multibyte or wide character}}
+    invalid or incomplete multibyte or wide character} {}}
 
 test io-75.12 {invalid utf-8 encoding read is ignored} -setup {
     set fn [makeFile {} io-75.12]
@@ -9376,12 +9376,13 @@ test io-75.13 {
 } -body {
     set d [read $f]
     binary scan $d H* hd
-    lappend hd [catch {read $f} msg] $msg
+    lappend hd [catch {read $f} msg data] $msg [dict get $data -data]
 } -cleanup {
     close $f
     removeFile io-75.13
+    unset d hd msg data
 } -match glob -result {41 1 {error reading "file*":\
-    invalid or incomplete multibyte or wide character}}
+    invalid or incomplete multibyte or wide character} {}}
 
 test io-75.14 {
 	[gets] succesfully returns lines prior to error
@@ -9397,7 +9398,7 @@ test io-75.14 {
     fconfigure $chan -encoding utf-8 -buffering none -eofchar {} \
 	-translation auto -profile strict
 } -body {
-    lappend res [gets $chan]
+    set res [gets $chan]
     lappend res [gets $chan]
     lappend res [catch {gets $chan} cres] $cres
     chan configure $chan -profile tcl8
-- 
cgit v0.12