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


From b072039e2175a46e30af3538857dd83f656b5ea4 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Mon, 6 Nov 2023 15:47:32 +0000
Subject: Document tip-653 changes on read: Key "-data" for already decoded
 data on encoding error

---
 doc/read.n | 15 +++++++++++----
 1 file changed, 11 insertions(+), 4 deletions(-)

diff --git a/doc/read.n b/doc/read.n
index 2add683..7c0c155 100644
--- a/doc/read.n
+++ b/doc/read.n
@@ -61,13 +61,15 @@ An encoding error is reported by the POSIX error code \fBEILSEQ\fR.
 In blocking mode, the error is directly thrown, even, if there is a
 leading decodable data portion.
 The file pointer is advanced just before the encoding error.
-An eventual well decoded data chunk before the encoding error is lost.
-It is proposed to return this portion within the additional key \fB-data\fR
-in the error dictionary.
+An eventual well decoded data chunk before the encoding error is returned
+in the error option dictionary key \fB-data\fR.
+The value of the key contains the empty string, if the error arises at the
+first data position.
 .PP
 In non blocking mode, first, any data without encoding error is returned
 (without error state).
 In the next call, no data is returned and the \fBEILSEQ\fR error state is set.
+The key \fB-data\fR is not present.
 .PP
 Here is an example with an encoding error in UTF-8 encoding, which is then
 introspected by a switch to the binary encoding. The test file contains a not
@@ -87,7 +89,7 @@ file35a65a0
 % catch {read $f} e d
 1
 % set d
--code 1 -level 0
+-data A -code 1 -level 0
 -errorstack {INNER {invokeStk1 read file35a65a0}}
 -errorcode {POSIX EILSEQ {invalid or incomplete multibyte or wide character}}
 -errorinfo {...} -errorline 1
@@ -98,6 +100,11 @@ file35a65a0
 ÃB
 % close $f
 .CE
+The already decoded data "A" is returned in the error options dictionary key
+\fB-data\fR.
+The file position is advanced on the encoding error position 1.
+The data at the error position is thus recovered by the next \fBread\fR command.
+.PP
 Non blocking example
 .
 .CS
-- 
cgit v0.12


From 436509ded2037b6ff1e430320e2f3cfddcfa937f Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Tue, 7 Nov 2023 12:42:54 +0000
Subject: TIP 653: adopted implementation to new text to only return "-data" if
 potential data loss. Check for non-blocking missing

---
 generic/tclIOCmd.c | 14 ++++++++------
 tests/io.test      | 20 ++++++++++----------
 2 files changed, 18 insertions(+), 16 deletions(-)

diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index cd7fbff..0827858 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -318,9 +318,7 @@ Tcl_GetsObjCmd(
     lineLen = Tcl_GetsObj(chan, linePtr);
     if (lineLen == TCL_IO_FAILURE) {
 	if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
-	    Tcl_Obj *returnOptsPtr = Tcl_NewDictObj();
-	    Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-data", -1),
-		    linePtr);
+	    Tcl_DecrRefCount(linePtr);
 
 	    /*
 	     * TIP #219.
@@ -335,7 +333,6 @@ Tcl_GetsObjCmd(
 			TclGetString(chanObjPtr), Tcl_PosixError(interp)));
 	    }
 	    code = TCL_ERROR;
-	    Tcl_SetReturnOptions(interp, returnOptsPtr);
 	    goto done;
 	}
 	lineLen = TCL_IO_FAILURE;
@@ -462,9 +459,14 @@ Tcl_ReadObjCmd(
     TclChannelPreserve(chan);
     charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
     if (charactersRead == TCL_IO_FAILURE) {
+
 	Tcl_Obj *returnOptsPtr = Tcl_NewDictObj();
-	Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-data", -1),
-		resultPtr);
+	/* check for blocking and encoding error */
+	/* TODO: check for blocking missing */
+	if ( Tcl_GetErrno() == EILSEQ ) {
+	    Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-data", -1),
+		    resultPtr);
+	}
 	/*
 	 * TIP #219.
 	 * Capture error messages put by the driver into the bypass area and
diff --git a/tests/io.test b/tests/io.test
index 997dadd..a427541 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -1560,7 +1560,7 @@ test io-12.9 {ReadChars: multibyte chars split} -body {
     read $f
     scan [string index $in end] %c
 } -cleanup {
-    close $f
+    catch {close $f}
 } -result 194
 test io-12.10 {ReadChars: multibyte chars split} -body {
     set f [open $path(test1) w]
@@ -9212,7 +9212,7 @@ test io-75.6 {invalid utf-8 encoding, gets is not ignored (-profile strict)} -se
 	invalid or incomplete multibyte or wide character}
 
 test io-75.7 {
-    invalid utf-8 encoding gets is not ignored (-profile strict)
+    invalid utf-8 encoding read is not ignored (-profile strict)
 } -setup {
     set fn [makeFile {} io-75.7]
     set f [open $fn w+]
@@ -9340,7 +9340,7 @@ test io-75.10 {incomplete multibyte encoding read is ignored} -setup {
 
 # As utf-8 has a special treatment in multi-byte decoding, also test another
 # one.
-test io-75.11 {shiftjis encoding error read results in raw bytes} -setup {
+test io-75.11 {shiftjis encoding error read results in error (strict profile)} -setup {
     set fn [makeFile {} io-75.11]
     set f [open $fn w+]
     fconfigure $f -encoding binary
@@ -9395,13 +9395,13 @@ test io-75.13 {
 } -body {
     set d [read $f]
     binary scan $d H* hd
-    lappend hd [catch {read $f} msg data] $msg [dict get $data -data]
+    lappend hd [catch {read $f} msg data] $msg [dict exists $data -data]
 } -cleanup {
     close $f
     removeFile io-75.13
     unset d hd msg data f fn
 } -match glob -result {41 1 {error reading "file*":\
-    invalid or incomplete multibyte or wide character} {}}
+    invalid or incomplete multibyte or wide character} 0}
 
 test io-75.14 {
 	[gets] succesfully returns lines prior to error
@@ -9419,7 +9419,7 @@ test io-75.14 {
 } -body {
     set res [gets $chan]
     lappend res [gets $chan]
-    lappend res [catch {gets $chan} msg data] $msg [dict get $data -data]
+    lappend res [catch {gets $chan} msg data] $msg [dict exists $data -data]
     chan configure $chan -profile tcl8
     lappend res [gets $chan]
     lappend res [gets $chan]
@@ -9428,7 +9428,7 @@ test io-75.14 {
     close $chan
     unset chan res msg data
 } -match glob -result {a b 1 {error reading "*":\
-    invalid or incomplete multibyte or wide character} c cÀ d}
+    invalid or incomplete multibyte or wide character} 0 cÀ d}
 
 test io-75.15 {
     invalid utf-8 encoding strict
@@ -9446,8 +9446,8 @@ test io-75.15 {
     fconfigure $chan -encoding utf-8 -profile strict
     lappend res [gets $chan]
     lappend res [gets $chan]
-    lappend res [catch {gets $chan} msg data] $msg [dict get $data -data]
-    lappend res [catch {gets $chan} msg data] $msg [dict get $data -data]
+    lappend res [catch {gets $chan} msg data] $msg [dict exists $data -data]
+    lappend res [catch {gets $chan} msg data] $msg [dict exists $data -data]
 	chan configure $chan -translation binary
 	set data [read $chan 4]
 	foreach char [split $data {}] {
@@ -9462,7 +9462,7 @@ test io-75.15 {
     close $chan
     unset chan res msg data
 } -match glob -result {hello AB 1 {error reading "*": invalid or incomplete multibyte or wide character}\
-    CD 1 {error reading "*": invalid or incomplete multibyte or wide character} CD 43 44 c0 40 EF GHI}
+    0 1 {error reading "*": invalid or incomplete multibyte or wide character} 0 43 44 c0 40 EF GHI}
 
 # ### ### ### ######### ######### #########
 
-- 
cgit v0.12


From b50cf76d6fd8274a93a5d041ec2a568a549293fe Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 8 Nov 2023 21:46:48 +0000
Subject: In the zipfs archive initialization, use Tcl_SetPreInitScript() to
 equip the creation of every interp by the Tcl library with the knowledge of
 where in the archive the script library is to be found.

This is the **documented example usage** for Tcl_SetPreInitScript.

POSTSCRIPT: Moved to development branch.  Still needs some verification.
---
 generic/tclZipfs.c | 58 ++++++++++++++++++++++++++++++++++++++++++------------
 1 file changed, 45 insertions(+), 13 deletions(-)

diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 842d51a..4d95973 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -91,6 +91,17 @@ static const z_crc_t* crc32tab;
 #define ZIPFS_VOLUME_LEN  9
 #define ZIPFS_APP_MOUNT	  ZIPFS_VOLUME "app"
 #define ZIPFS_ZIP_MOUNT	  ZIPFS_VOLUME "lib/tcl"
+
+#define ZIPFS_SCRIPT_PREFIX	"set ::tcl_library "
+#define ZIPFS_TCL_LIBRARY_1	ZIPFS_APP_MOUNT "/tcl_library"
+#define ZIPFS_INIT_SCRIPT_1	ZIPFS_SCRIPT_PREFIX ZIPFS_TCL_LIBRARY_1
+
+#define ZIPFS_TCL_LIBRARY_2	ZIPFS_ZIP_MOUNT
+#define ZIPFS_INIT_SCRIPT_2	ZIPFS_SCRIPT_PREFIX ZIPFS_TCL_LIBRARY_2
+
+#define ZIPFS_TCL_LIBRARY_3	ZIPFS_ZIP_MOUNT "/tcl_library"
+#define ZIPFS_INIT_SCRIPT_3	ZIPFS_SCRIPT_PREFIX ZIPFS_TCL_LIBRARY_3
+
 #define ZIPFS_FALLBACK_ENCODING "cp437"
 
 /*
@@ -313,6 +324,7 @@ static const char pwrot[17] =
     "\x10\x90\x50\xD0\x30\xB0\x70\xF0";
 
 static const char *zipfs_literal_tcl_library = NULL;
+static const char *zipfs_init_script = NULL;
 
 /* Function prototypes */
 
@@ -4231,6 +4243,28 @@ ScriptLibrarySetup(
     Tcl_Obj *libDirObj = Tcl_NewStringObj(dirName, -1);
     Tcl_Obj *subDirObj, *searchPathObj;
 
+    /*
+     * We know where the init.tcl is located in the attached script library
+     * archive.  Use a pre-init script to tell every Tcl interp as it gets
+     * created where that is, so none of them need to construct and then
+     * iterate through some search path.  That's the literal documented
+     * purpose of Tcl_SetPreInitScript().  Use it.
+     *
+     * TODO: Examine why we need so many variations and eliminate as many
+     * as possible.
+     */
+
+    if (0 == strcmp(zipfs_literal_tcl_library, ZIPFS_TCL_LIBRARY_1)) {
+	zipfs_init_script = ZIPFS_INIT_SCRIPT_1;
+    } else if (0 == strcmp(zipfs_literal_tcl_library, ZIPFS_TCL_LIBRARY_2)) {
+	zipfs_init_script = ZIPFS_INIT_SCRIPT_2;
+    } else if (0 == strcmp(zipfs_literal_tcl_library, ZIPFS_TCL_LIBRARY_3)) {
+	zipfs_init_script = ZIPFS_INIT_SCRIPT_3;
+    }
+    if (zipfs_init_script) {
+	Tcl_SetPreInitScript(zipfs_init_script);
+    }
+
     TclNewLiteralStringObj(subDirObj, "encoding");
     Tcl_IncrRefCount(subDirObj);
     TclNewObj(searchPathObj);
@@ -4268,13 +4302,12 @@ TclZipfs_TclLibrary(void)
      * Look for the library file system within the executable.
      */
 
-    vfsInitScript = Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",
-	    -1);
+    vfsInitScript = Tcl_NewStringObj(ZIPFS_TCL_LIBRARY_1 "/init.tcl", -1);
     Tcl_IncrRefCount(vfsInitScript);
     found = Tcl_FSAccess(vfsInitScript, F_OK);
     Tcl_DecrRefCount(vfsInitScript);
     if (found == TCL_OK) {
-	zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
+	zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1;
 	return ScriptLibrarySetup(zipfs_literal_tcl_library);
     }
 
@@ -6283,22 +6316,21 @@ ZipfsAppHookFindTclInit(
 	return TCL_ERROR;
     }
 
-    TclNewLiteralStringObj(vfsInitScript, ZIPFS_ZIP_MOUNT "/init.tcl");
+    TclNewLiteralStringObj(vfsInitScript, ZIPFS_TCL_LIBRARY_2 "/init.tcl");
     Tcl_IncrRefCount(vfsInitScript);
     found = Tcl_FSAccess(vfsInitScript, F_OK);
     Tcl_DecrRefCount(vfsInitScript);
     if (found == 0) {
-	zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT;
+	zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_2;
 	return TCL_OK;
     }
 
-    TclNewLiteralStringObj(vfsInitScript,
-	    ZIPFS_ZIP_MOUNT "/tcl_library/init.tcl");
+    TclNewLiteralStringObj(vfsInitScript, ZIPFS_TCL_LIBRARY_3 "/init.tcl");
     Tcl_IncrRefCount(vfsInitScript);
     found = Tcl_FSAccess(vfsInitScript, F_OK);
     Tcl_DecrRefCount(vfsInitScript);
     if (found == 0) {
-	zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT "/tcl_library";
+	zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_3;
 	return TCL_OK;
     }
 
@@ -6415,12 +6447,12 @@ TclZipfs_AppHook(
 
 	if (!zipfs_literal_tcl_library) {
 	    TclNewLiteralStringObj(vfsInitScript,
-		    ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
+		    ZIPFS_TCL_LIBRARY_1 "/init.tcl");
 	    Tcl_IncrRefCount(vfsInitScript);
 	    found = Tcl_FSAccess(vfsInitScript, F_OK);
 	    Tcl_DecrRefCount(vfsInitScript);
 	    if (found == TCL_OK) {
-		zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
+		zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1;
 		return version;
 	    }
 	}
@@ -6449,7 +6481,7 @@ TclZipfs_AppHook(
 
 	    TclZipfs_TclLibrary();
 	    TclNewLiteralStringObj(vfsInitScript,
-		    ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl");
+		    ZIPFS_TCL_LIBRARY_3 "install.tcl");
 	    Tcl_IncrRefCount(vfsInitScript);
 	    if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
 		Tcl_SetStartupScript(vfsInitScript, NULL);
@@ -6472,12 +6504,12 @@ TclZipfs_AppHook(
 	    }
 	    /* Set Tcl Encodings */
 	    TclNewLiteralStringObj(vfsInitScript,
-		    ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
+		    ZIPFS_TCL_LIBRARY_1 "/init.tcl");
 	    Tcl_IncrRefCount(vfsInitScript);
 	    found = Tcl_FSAccess(vfsInitScript, F_OK);
 	    Tcl_DecrRefCount(vfsInitScript);
 	    if (found == TCL_OK) {
-		zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
+		zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1;
 		return version;
 	    }
 	}
-- 
cgit v0.12


From 4c391a13ae96bbc5307b97af37bafa4e58ab5b86 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 13 Nov 2023 19:24:20 +0000
Subject: Make calls early to find the script library in zipfs archive and
 alert the Tcl library to its location so that all interps find it when
 created.

---
 generic/tclZipfs.c | 22 ++++++++++++++--------
 1 file changed, 14 insertions(+), 8 deletions(-)

diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index adb7802..36fc82a 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -6453,6 +6453,7 @@ TclZipfs_AppHook(
 	    Tcl_DecrRefCount(vfsInitScript);
 	    if (found == TCL_OK) {
 		zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1;
+		Tcl_DecrRefCount(TclZipfs_TclLibrary());
 		return version;
 	    }
 	}
@@ -6479,7 +6480,7 @@ TclZipfs_AppHook(
 	     * wants it.
 	     */
 
-	    TclZipfs_TclLibrary();
+	    Tcl_DecrRefCount(TclZipfs_TclLibrary());
 	    TclNewLiteralStringObj(vfsInitScript,
 		    ZIPFS_TCL_LIBRARY_3 "install.tcl");
 	    Tcl_IncrRefCount(vfsInitScript);
@@ -6491,6 +6492,17 @@ TclZipfs_AppHook(
 	    int found;
 	    Tcl_Obj *vfsInitScript;
 
+	    /* Set Tcl Encodings */
+	    TclNewLiteralStringObj(vfsInitScript,
+		    ZIPFS_TCL_LIBRARY_1 "/init.tcl");
+	    Tcl_IncrRefCount(vfsInitScript);
+	    found = Tcl_FSAccess(vfsInitScript, F_OK);
+	    Tcl_DecrRefCount(vfsInitScript);
+	    if (found == TCL_OK) {
+		zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1;
+		Tcl_DecrRefCount(TclZipfs_TclLibrary());
+	    }
+
 	    TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
 	    Tcl_IncrRefCount(vfsInitScript);
 	    if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
@@ -6502,14 +6514,8 @@ TclZipfs_AppHook(
 	    } else {
 		Tcl_DecrRefCount(vfsInitScript);
 	    }
-	    /* Set Tcl Encodings */
-	    TclNewLiteralStringObj(vfsInitScript,
-		    ZIPFS_TCL_LIBRARY_1 "/init.tcl");
-	    Tcl_IncrRefCount(vfsInitScript);
-	    found = Tcl_FSAccess(vfsInitScript, F_OK);
-	    Tcl_DecrRefCount(vfsInitScript);
+
 	    if (found == TCL_OK) {
-		zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1;
 		return version;
 	    }
 	}
-- 
cgit v0.12


From 480e67920e6d8c3b9c536cfc1683f6349a9b319a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 13 Nov 2023 19:36:30 +0000
Subject: Now that the robust, early method of directing Tcl to find its script
 library in the zipfs archive is in place, we can yank out the hacky approach
 of defining a semi-secret command to extend a search path.

Re-open the feature branch.  Integration was pulled back when some
reports of failures on some build configurations came in.
---
 generic/tclInterp.c |  1 -
 generic/tclZipfs.c  | 40 ----------------------------------------
 2 files changed, 41 deletions(-)

diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index ed3c527..b023615 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -402,7 +402,6 @@ Tcl_Init(
 "if {$tail eq [info tclversion]} continue\n"
 "file join [file dirname $env(TCL_LIBRARY)] tcl[info tclversion]}\n"
 "	}\n"
-"	lappend scripts {::tcl::zipfs::tcl_library_init}\n"
 "	if {[info exists tclDefaultLibrary]} {\n"
 "	    lappend scripts {set tclDefaultLibrary}\n"
 "	} else {\n"
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 36fc82a..adabcda 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -4356,44 +4356,6 @@ TclZipfs_TclLibrary(void)
 /*
  *-------------------------------------------------------------------------
  *
- * ZipFSTclLibraryObjCmd --
- *
- *	This procedure is invoked to process the
- *	[::tcl::zipfs::tcl_library_init] command, usually called during the
- *	execution of Tcl's interpreter startup. It returns the root that Tcl's
- *	library files are mounted under.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	May initialise the cache of where such library files are to be found.
- *	This cache is never cleared.
- *
- *-------------------------------------------------------------------------
- */
-
-static int
-ZipFSTclLibraryObjCmd(
-    TCL_UNUSED(void *),
-    Tcl_Interp *interp,		/* Current interpreter. */
-    TCL_UNUSED(int) /*objc*/,
-    TCL_UNUSED(Tcl_Obj *const *)) /*objv*/
-{
-    if (!Tcl_IsSafe(interp)) {
-	Tcl_Obj *pResult = TclZipfs_TclLibrary();
-
-	if (!pResult) {
-	    TclNewObj(pResult);
-	}
-	Tcl_SetObjResult(interp, pResult);
-    }
-    return TCL_OK;
-}
-
-/*
- *-------------------------------------------------------------------------
- *
  * ZipChannelClose --
  *
  *	This function is called to close a channel.
@@ -6286,8 +6248,6 @@ TclZipfs_Init(
 	Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);
 	Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", -1),
 		Tcl_NewStringObj("::tcl::zipfs::find", -1));
-	Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init",
-		ZipFSTclLibraryObjCmd, NULL, NULL);
 	Tcl_PkgProvide(interp, "tcl::zipfs", "2.0");
     }
     return TCL_OK;
-- 
cgit v0.12


From 2e628b79d9fe0fe590cbab9bea27c1fdf11082f9 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 14 Nov 2023 11:07:13 +0000
Subject: Add test for blocking mode

---
 generic/tclIO.c    | 29 ++++++++++++++++++++++++++++-
 generic/tclIOCmd.c | 12 ++++++------
 generic/tclInt.h   |  1 +
 tests/io.test      |  4 ++--
 4 files changed, 37 insertions(+), 9 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index bc1b1c6..0047f0b 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4934,7 +4934,7 @@ Tcl_GetsObj(
 	     * two times, as gs.bytesWrote is not 0 on the first pass. This feels
 	     * once to much, as the data is anyway not used.
 	     */
-	     
+
 	    /* Set eol to the position that caused the encoding error, and then
 	     * continue to gotEOL, which stores the data that was decoded
 	     * without error to objPtr.  This allows the caller to do something
@@ -7616,6 +7616,33 @@ Tcl_Eof(
     return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0;
 }
 
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclChannelGetBlockingMode --
+ *
+ *	Returns 1 if the channel is in blocking mode (default), 0 otherwise.
+ *
+ * Results:
+ *	1 or 0, always.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclChannelGetBlockingMode(
+    Tcl_Channel chan)
+{
+    ChannelState *statePtr = ((Channel *) chan)->state;
+				/* State of real channel structure. */
+
+    return GotFlag(statePtr, CHANNEL_NONBLOCKING) ? 0 : 1;
+}
+
 /*
  *----------------------------------------------------------------------
  *
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 0827858..9667419 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -459,11 +459,9 @@ Tcl_ReadObjCmd(
     TclChannelPreserve(chan);
     charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
     if (charactersRead == TCL_IO_FAILURE) {
-
-	Tcl_Obj *returnOptsPtr = Tcl_NewDictObj();
-	/* check for blocking and encoding error */
-	/* TODO: check for blocking missing */
-	if ( Tcl_GetErrno() == EILSEQ ) {
+	Tcl_Obj *returnOptsPtr = NULL;
+	if (TclChannelGetBlockingMode(chan)) {
+	    returnOptsPtr = Tcl_NewDictObj();
 	    Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-data", -1),
 		    resultPtr);
 	}
@@ -480,7 +478,9 @@ Tcl_ReadObjCmd(
 		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));
 	}
 	TclChannelRelease(chan);
-	Tcl_SetReturnOptions(interp, returnOptsPtr);
+	if (returnOptsPtr) {
+	    Tcl_SetReturnOptions(interp, returnOptsPtr);
+	}
 	return TCL_ERROR;
     }
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 3d8a702..f696ad2 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3112,6 +3112,7 @@ MODULE_SCOPE int	TclByteArrayMatch(const unsigned char *string,
 MODULE_SCOPE double	TclCeil(const void *a);
 MODULE_SCOPE void	TclChannelPreserve(Tcl_Channel chan);
 MODULE_SCOPE void	TclChannelRelease(Tcl_Channel chan);
+MODULE_SCOPE int	TclChannelGetBlockingMode(Tcl_Channel chan);
 MODULE_SCOPE int	TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr,
 			    Var *arrayPtr, Tcl_Obj *name, int index);
 MODULE_SCOPE int	TclCheckBadOctal(Tcl_Interp *interp,
diff --git a/tests/io.test b/tests/io.test
index 0737c2d..75e30aa 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -9432,13 +9432,13 @@ test io-75.11 {shiftjis encoding error read results in error (strict profile)} -
 } -body {
     set d [read $f]
     binary scan $d H* hd
-    lappend hd [catch {set d [read $f]} msg data] $msg [dict get $data -data]
+    lappend hd [catch {set d [read $f]} msg data] $msg [dict exists $data -data]
 } -cleanup {
     close $f
     removeFile io-75.11
     unset d hd msg data f
 } -match glob -result {41 1 {error reading "file*":\
-    invalid or incomplete multibyte or wide character} {}}
+    invalid or incomplete multibyte or wide character} 0}
 
 test io-75.12 {invalid utf-8 encoding read is ignored} -setup {
     set fn [makeFile {} io-75.12]
-- 
cgit v0.12