From 19206eee69e8c22d63104af1b7f1f815969bff7f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 10 Nov 2022 18:20:23 +0100
Subject: grafts: Run with a UTF-8 locale.

Fixes <https://issues.guix.gnu.org/55968>.
Reported by Maxime Devos <maximedevos@telenet.be>.

* guix/grafts.scm (%graft-with-utf8-locale?): New parameter.
(graft-derivation/shallow)[glibc-locales, set-utf8-locale]: New
variables.
[build]: Use 'set-utf8-locale'.
* tests/gexp.scm, tests/grafts.scm, tests/packages.scm: Set
'%graft-with-utf8-locale?' to #f.
---
 guix/grafts.scm | 24 +++++++++++++++++++++++-
 1 file changed, 23 insertions(+), 1 deletion(-)

(limited to 'guix/grafts.scm')

diff --git a/guix/grafts.scm b/guix/grafts.scm
index 1686aa1413..f93da32981 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -40,7 +40,9 @@
             graft-replacement-output
 
             graft-derivation
-            graft-derivation/shallow)
+            graft-derivation/shallow
+
+            %graft-with-utf8-locale?)
   #:re-export (%graft?                            ;for backward compatibility
                without-grafting
                set-grafting
@@ -79,6 +81,12 @@
     (($ <graft> (? string? item))
      item)))
 
+(define %graft-with-utf8-locale?
+  ;; Whether to install a UTF-8 locale for grafting.  This parameter exists
+  ;; for the sole purpose of being able to run tests without having to build
+  ;; 'glibc-utf8-locales'.
+  (make-parameter #t))
+
 (define* (graft-derivation/shallow drv grafts
                                    #:key
                                    (name (derivation-name drv))
@@ -88,6 +96,10 @@
   "Return a derivation called NAME, which applies GRAFTS to the specified
 OUTPUTS of DRV.  This procedure performs \"shallow\" grafting in that GRAFTS
 are not recursively applied to dependencies of DRV."
+  (define glibc-locales
+    (module-ref (resolve-interface '(gnu packages commencement))
+                'glibc-utf8-locales-final))
+
   (define mapping
     ;; List of store item pairs.
     (map (lambda (graft)
@@ -98,6 +110,15 @@ are not recursively applied to dependencies of DRV."
                        (graft-replacement-output graft)))))
          grafts))
 
+  (define set-utf8-locale
+    (and (%graft-with-utf8-locale?)
+         #~(begin
+             ;; Let Guile interpret file names as UTF-8.
+             (setenv "GUIX_LOCPATH"
+                     #+(file-append glibc-locales "/lib/locale"))
+             (setlocale LC_ALL "en_US.utf8"))))
+
+
   (define build
     (with-imported-modules '((guix build graft)
                              (guix build utils)
@@ -111,6 +132,7 @@ are not recursively applied to dependencies of DRV."
           (define %outputs
             (ungexp (outputs->gexp outputs)))
 
+          #+set-utf8-locale
           (let* ((old-outputs '(ungexp
                                 (map (lambda (output)
                                        (gexp ((ungexp output)
-- 
cgit v1.2.3