diff options
| -rw-r--r-- | guix/grafts.scm | 24 | ||||
| -rw-r--r-- | tests/gexp.scm | 4 | ||||
| -rw-r--r-- | tests/grafts.scm | 5 | ||||
| -rw-r--r-- | tests/packages.scm | 3 |
4 files changed, 34 insertions, 2 deletions
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) diff --git a/tests/gexp.scm b/tests/gexp.scm index 6d57ac5d7a..7a90f8dcbf 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -21,6 +21,7 @@ #:use-module (guix store) #:use-module (guix monads) #:use-module (guix gexp) + #:use-module ((guix grafts) #:select (%graft-with-utf8-locale?)) #:use-module (guix derivations) #:use-module (guix packages) #:use-module (guix build-system trivial) @@ -49,6 +50,9 @@ ;; Globally disable grafts because they can trigger early builds. (%graft? #f) +;; When grafting, do not add dependency on 'glibc-utf8-locales'. +(%graft-with-utf8-locale? #f) + ;; For white-box testing. (define (gexp-inputs x) ((@@ (guix gexp) gexp-inputs) x)) diff --git a/tests/grafts.scm b/tests/grafts.scm index 7e1959e4a7..63dbb13830 100644 --- a/tests/grafts.scm +++ b/tests/grafts.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014-2019, 2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2021 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. @@ -35,6 +35,9 @@ (define %store (open-connection-for-tests)) +;; When grafting, do not add dependency on 'glibc-utf8-locales'. +(%graft-with-utf8-locale? #f) + (define (bootstrap-binary name) (let ((bin (search-bootstrap-binary name (%current-system)))) (and %store diff --git a/tests/packages.scm b/tests/packages.scm index a71eb1125d..a5819d8de3 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -75,6 +75,9 @@ ;; can trigger builds early.) (%graft? #f) +;; When grafting, do not add dependency on 'glibc-utf8-locales'. +(%graft-with-utf8-locale? #f) + (test-begin "packages") |