[bug#62243] [PATCH] gnu: guile-3.0-latest: Add patch for invalid unicode handling.

[Christopher Baines <mail@cbaines.net>]

This patch fixes handling of invalid unicode when using suspendable ports.

As the build coordinator agents use suspendable ports, this will fix issues
with building things where the log output contains invalid unicode.

* gnu/packages/patches/guile-fix-invalid-unicode-handling.patch: New file.
* gnu/local.mk (dist_patch_DATA): Add it.
* gnu/packages/guile.scm (guile-3.0-latest)[source]: Use it.
---
 gnu/local.mk                                  |  1 +
 gnu/packages/guile.scm                        |  4 +-
 .../guile-fix-invalid-unicode-handling.patch  | 80 +++++++++++++++++++
 3 files changed, 84 insertions(+), 1 deletion(-)
 create mode 100644 gnu/packages/patches/guile-fix-invalid-unicode-handling.patch

diff --git a/gnu/local.mk b/gnu/local.mk
index 0a1a5d077f..25e24206e8 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1294,6 +1294,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/guile-fibers-epoll-instance-is-dead.patch \
   %D%/packages/patches/guile-fibers-fd-finalizer-leak.patch	\
   %D%/packages/patches/guile-fibers-wait-for-io-readiness.patch \
+  %D%/packages/patches/guile-fix-invalid-unicode-handling.patch \
   %D%/packages/patches/guile-gdbm-ffi-support-gdbm-1.14.patch	\
   %D%/packages/patches/guile-git-adjust-for-libgit2-1.2.0.patch \
   %D%/packages/patches/guile-present-coding.patch		\
diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm
index 2fd9b711ce..b6db506140 100644
--- a/gnu/packages/guile.scm
+++ b/gnu/packages/guile.scm
@@ -398,7 +398,9 @@ (define-public guile-3.0-latest
                                   version ".tar.xz"))
               (sha256
                (base32
-                "03bm1mnfc9kkg2ls942a0js7bxrdzmcffgrgg6anwdmjfan2a9hs"))))
+                "03bm1mnfc9kkg2ls942a0js7bxrdzmcffgrgg6anwdmjfan2a9hs"))
+              (patches (search-patches
+                        "guile-fix-invalid-unicode-handling.patch"))))
     (arguments
      (substitute-keyword-arguments (package-arguments guile-3.0)
        ;; Guile 3.0.9 is bit-reproducible when built in parallel, thanks to
diff --git a/gnu/packages/patches/guile-fix-invalid-unicode-handling.patch b/gnu/packages/patches/guile-fix-invalid-unicode-handling.patch
new file mode 100644
index 0000000000..97b0f19057
--- /dev/null
+++ b/gnu/packages/patches/guile-fix-invalid-unicode-handling.patch
@@ -0,0 +1,80 @@
+From 31a1c3c4783e8e66b93500737f23f209d8115f77 Mon Sep 17 00:00:00 2001
+From: Christopher Baines <mail@cbaines.net>
+Date: Fri, 17 Mar 2023 12:48:39 +0000
+Subject: [PATCH] Fix some invalid unicode handling issues with suspendable
+ ports.
+
+Based on the implementation in ports.c.  I don't understand what this
+code is really doing, but the suspendable ports implementation differs
+from the similar C code for a couple of inequalities.
+
+* module/ice-9/suspendable-ports.scm (decode-utf8, bad-utf8-len): Flip a
+couple of inequalities.
+* test-suite/tests/ports.test ("string ports"): Add additional invalid
+UTF-8 test case.
+---
+ module/ice-9/suspendable-ports.scm | 8 ++++----
+ test-suite/tests/ports.test        | 7 +++++++
+ 2 files changed, 11 insertions(+), 4 deletions(-)
+
+diff --git a/module/ice-9/suspendable-ports.scm b/module/ice-9/suspendable-ports.scm
+index a823f1d37..9fac1df62 100644
+--- a/module/ice-9/suspendable-ports.scm
++++ b/module/ice-9/suspendable-ports.scm
+@@ -419,7 +419,7 @@
+                (= (logand u8_2 #xc0) #x80)
+                (case u8_0
+                  ((#xe0) (>= u8_1 #xa0))
+-                 ((#xed) (>= u8_1 #x9f))
++                 ((#xed) (<= u8_1 #x9f))
+                  (else #t)))
+           (kt (integer->char
+                (logior (ash (logand u8_0 #x0f) 12)
+@@ -436,7 +436,7 @@
+                (= (logand u8_3 #xc0) #x80)
+                (case u8_0
+                  ((#xf0) (>= u8_1 #x90))
+-                 ((#xf4) (>= u8_1 #x8f))
++                 ((#xf4) (<= u8_1 #x8f))
+                  (else #t)))
+           (kt (integer->char
+                (logior (ash (logand u8_0 #x07) 18)
+@@ -462,7 +462,7 @@
+      ((< buffering 2) 1)
+      ((not (= (logand (ref 1) #xc0) #x80)) 1)
+      ((and (eq? first-byte #xe0) (< (ref 1) #xa0)) 1)
+-     ((and (eq? first-byte #xed) (< (ref 1) #x9f)) 1)
++     ((and (eq? first-byte #xed) (> (ref 1) #x9f)) 1)
+      ((< buffering 3) 2)
+      ((not (= (logand (ref 2) #xc0) #x80)) 2)
+      (else 0)))
+@@ -471,7 +471,7 @@
+      ((< buffering 2) 1)
+      ((not (= (logand (ref 1) #xc0) #x80)) 1)
+      ((and (eq? first-byte #xf0) (< (ref 1) #x90)) 1)
+-     ((and (eq? first-byte #xf4) (< (ref 1) #x8f)) 1)
++     ((and (eq? first-byte #xf4) (> (ref 1) #x8f)) 1)
+      ((< buffering 3) 2)
+      ((not (= (logand (ref 2) #xc0) #x80)) 2)
+      ((< buffering 4) 3)
+diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
+index 66e10e3dd..1b30e1a68 100644
+--- a/test-suite/tests/ports.test
++++ b/test-suite/tests/ports.test
+@@ -1059,6 +1059,13 @@
+        eof))
+ 
+     (test-decoding-error (#xf0 #x88 #x88 #x88) "UTF-8"
++      (error                ;; 2nd byte should be in the 90..BF range
++       error                ;; 88: not a valid starting byte
++       error                ;; 88: not a valid starting byte
++       error                ;; 88: not a valid starting byte
++       eof))
++
++    (test-decoding-error (#xf4 #xa4 #xbd #xa4) "UTF-8"
+       (error                ;; 2nd byte should be in the 90..BF range
+        error                ;; 88: not a valid starting byte
+        error                ;; 88: not a valid starting byte
+-- 
+2.39.1
+
-- 
2.39.1