profiles: Remove dependency on 'glibc-utf8-locales' for tests.

Commit 1af0860e8be81c01ad405c1226d6bc4516e62863 added a mandatory
dependency on 'glibc-utf8-locales', which entails long rebuilds for
tests.

* guix/profiles.scm (profile-derivation): Add #:locales? parameter.
Add 'set-utf8-locale' variable.  Use it when LOCALES? is true.
(link-to-empty-profile): Pass #:locales? #f.
* guix/scripts/environment.scm (inputs->profile-derivation): Pass
  #:locales?.
* guix/scripts/package.scm (build-and-use-profile): Likewise.
* tests/packages.scm ("--search-paths with pattern"): Pass #:locales? #f.
* tests/profiles.scm ("profile-derivation")
("profile-derivation, inputs", "profile-manifest, search-paths")
("etc/profile", "etc/profile when etc/ already exists"):
("etc/profile when etc/ is a symlink"): Likewise.

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 82d8b33..e7707b6 100644 (file)
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -919,10 +919,14 @@ files for the truetype fonts of the @var{manifest} entries."
 (define* (profile-derivation manifest
                              #:key
                              (hooks %default-profile-hooks)
+                             (locales? #t)
                              system)
   "Return a derivation that builds a profile (aka. 'user environment') with
 the given MANIFEST.  The profile includes additional derivations returned by
-the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc."
+the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc.
+
+When LOCALES? is true, the build is performed under a UTF-8 locale; this adds
+a dependency on the 'glibc-utf8-locales' package."
   (mlet %store-monad ((system (if system
                                   (return system)
                                   (current-system)))
@@ -943,6 +947,15 @@ the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc."
       (module-ref (resolve-interface '(gnu packages base))
                   'glibc-utf8-locales))
 
+    (define set-utf8-locale
+      ;; Some file names (e.g., in 'nss-certs') are UTF-8 encoded so
+      ;; install a UTF-8 locale.
+      #~(begin
+          (setenv "LOCPATH"
+                  #$(file-append glibc-utf8-locales "/lib/locale/"
+                                 (package-version glibc-utf8-locales)))
+          (setlocale LC_ALL "en_US.utf8")))
+
     (define builder
       (with-imported-modules '((guix build profiles)
                                (guix build union)
@@ -957,12 +970,7 @@ the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc."
             (setvbuf (current-output-port) _IOLBF)
             (setvbuf (current-error-port) _IOLBF)
 
-            ;; Some file names (e.g., in 'nss-certs') are UTF-8 encoded so
-            ;; install a UTF-8 locale.
-            (setenv "LOCPATH"
-                    (string-append #+glibc-utf8-locales "/lib/locale/"
-                                   #+(package-version glibc-utf8-locales)))
-            (setlocale LC_ALL "en_US.utf8")
+            #+(if locales? set-utf8-locale #t)
 
             (define search-paths
               ;; Search paths of MANIFEST's packages, converted back to their
@@ -1110,7 +1118,8 @@ case when generations have been deleted (there are \"holes\")."
   "Link GENERATION, a string, to the empty profile.  An error is raised if
 that fails."
   (let* ((drv  (run-with-store store
-                 (profile-derivation (manifest '()))))
+                 (profile-derivation (manifest '())
+                                     #:locales? #f)))
          (prof (derivation->output-path drv "out")))
     (build-derivations store (list drv))
     (switch-symlinks generation prof)))

diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 6dea67c..7201d98 100644 (file)
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -323,7 +323,8 @@ profile."
                       #:system system
                       #:hooks (if bootstrap?
                                   '()
-                                  %default-profile-hooks)))
+                                  %default-profile-hooks)
+                      #:locales? (not bootstrap?)))
 
 (define requisites* (store-lift requisites))
 

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 96a22f6..90e7fa2 100644 (file)
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -200,7 +200,8 @@ specified in MANIFEST, a manifest object."
                      (profile-derivation manifest
                                          #:hooks (if bootstrap?
                                                      '()
-                                                     %default-profile-hooks))))
+                                                     %default-profile-hooks)
+                                         #:locales? (not bootstrap?))))
          (prof     (derivation->output-path prof-drv)))
     (show-what-to-build store (list prof-drv)
                         #:use-substitutes? use-substitutes?

diff --git a/tests/packages.scm b/tests/packages.scm
index 47e76b5..247f75c 100644 (file)
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -968,7 +968,8 @@
                  (profile-derivation
                   (manifest (map package->manifest-entry
                                  (list p1 p2)))
-                  #:hooks '())
+                  #:hooks '()
+                  #:locales? #f)
                  #:guile-for-build (%guile-for-build))))
     (build-derivations %store (list prof))
     (string-match (format #f "^export XML_CATALOG_FILES=\"~a/xml/+bar/baz/catalog\\.xml\"\n"

diff --git a/tests/profiles.scm b/tests/profiles.scm
index f9c2f54..5536364 100644 (file)
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -195,7 +195,8 @@
       ((entry ->   (package->manifest-entry %bootstrap-guile))
        (guile      (package->derivation %bootstrap-guile))
        (drv        (profile-derivation (manifest (list entry))
-                                       #:hooks '()))
+                                       #:hooks '()
+                                       #:locales? #f))
        (profile -> (derivation->output-path drv))
        (bindir ->  (string-append profile "/bin"))
        (_          (built-derivations (list drv))))
@@ -207,7 +208,8 @@
   (mlet* %store-monad
       ((entry ->   (package->manifest-entry packages:glibc "debug"))
        (drv        (profile-derivation (manifest (list entry))
-                                       #:hooks '())))
+                                       #:hooks '()
+                                       #:locales? #f)))
     (return (derivation-inputs drv))))
 
 (test-assert "package->manifest-entry defaults to \"out\""
@@ -228,7 +230,8 @@
                       (package-native-search-paths packages:guile-2.0))))
        (entry ->   (package->manifest-entry guile))
        (drv        (profile-derivation (manifest (list entry))
-                                       #:hooks '()))
+                                       #:hooks '()
+                                       #:locales? #f))
        (profile -> (derivation->output-path drv)))
     (mbegin %store-monad
       (built-derivations (list drv))
@@ -259,7 +262,8 @@
                       (package-native-search-paths packages:guile-2.0))))
        (entry ->   (package->manifest-entry guile))
        (drv        (profile-derivation (manifest (list entry))
-                                       #:hooks '()))
+                                       #:hooks '()
+                                       #:locales? #f))
        (profile -> (derivation->output-path drv)))
     (mbegin %store-monad
       (built-derivations (list drv))
@@ -293,7 +297,8 @@
                               (display "foo!" port))))))))
        (entry ->   (package->manifest-entry thing))
        (drv        (profile-derivation (manifest (list entry))
-                                       #:hooks '()))
+                                       #:hooks '()
+                                       #:locales? #f))
        (profile -> (derivation->output-path drv)))
     (mbegin %store-monad
       (built-derivations (list drv))
@@ -321,7 +326,8 @@
                               (display "foo!" port))))))))
        (entry ->   (package->manifest-entry thing))
        (drv        (profile-derivation (manifest (list entry))
-                                       #:hooks '()))
+                                       #:hooks '()
+                                       #:locales? #f))
        (profile -> (derivation->output-path drv)))
     (mbegin %store-monad
       (built-derivations (list drv))