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

Commit 1af0860e8b 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.
This commit is contained in:
Ludovic Courtès 2016-12-17 12:43:10 +01:00
parent d44fb7dd60
commit a6562c7e20
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
5 changed files with 35 additions and 17 deletions

View file

@ -919,10 +919,14 @@ files for the truetype fonts of the @var{manifest} entries."
(define* (profile-derivation manifest (define* (profile-derivation manifest
#:key #:key
(hooks %default-profile-hooks) (hooks %default-profile-hooks)
(locales? #t)
system) system)
"Return a derivation that builds a profile (aka. 'user environment') with "Return a derivation that builds a profile (aka. 'user environment') with
the given MANIFEST. The profile includes additional derivations returned by 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 (mlet %store-monad ((system (if system
(return system) (return system)
(current-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)) (module-ref (resolve-interface '(gnu packages base))
'glibc-utf8-locales)) '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 (define builder
(with-imported-modules '((guix build profiles) (with-imported-modules '((guix build profiles)
(guix build union) (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-output-port) _IOLBF)
(setvbuf (current-error-port) _IOLBF) (setvbuf (current-error-port) _IOLBF)
;; Some file names (e.g., in 'nss-certs') are UTF-8 encoded so #+(if locales? set-utf8-locale #t)
;; 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")
(define search-paths (define search-paths
;; Search paths of MANIFEST's packages, converted back to their ;; 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 "Link GENERATION, a string, to the empty profile. An error is raised if
that fails." that fails."
(let* ((drv (run-with-store store (let* ((drv (run-with-store store
(profile-derivation (manifest '())))) (profile-derivation (manifest '())
#:locales? #f)))
(prof (derivation->output-path drv "out"))) (prof (derivation->output-path drv "out")))
(build-derivations store (list drv)) (build-derivations store (list drv))
(switch-symlinks generation prof))) (switch-symlinks generation prof)))

View file

@ -323,7 +323,8 @@ profile."
#:system system #:system system
#:hooks (if bootstrap? #:hooks (if bootstrap?
'() '()
%default-profile-hooks))) %default-profile-hooks)
#:locales? (not bootstrap?)))
(define requisites* (store-lift requisites)) (define requisites* (store-lift requisites))

View file

@ -200,7 +200,8 @@ specified in MANIFEST, a manifest object."
(profile-derivation manifest (profile-derivation manifest
#:hooks (if bootstrap? #:hooks (if bootstrap?
'() '()
%default-profile-hooks)))) %default-profile-hooks)
#:locales? (not bootstrap?))))
(prof (derivation->output-path prof-drv))) (prof (derivation->output-path prof-drv)))
(show-what-to-build store (list prof-drv) (show-what-to-build store (list prof-drv)
#:use-substitutes? use-substitutes? #:use-substitutes? use-substitutes?

View file

@ -968,7 +968,8 @@
(profile-derivation (profile-derivation
(manifest (map package->manifest-entry (manifest (map package->manifest-entry
(list p1 p2))) (list p1 p2)))
#:hooks '()) #:hooks '()
#:locales? #f)
#:guile-for-build (%guile-for-build)))) #:guile-for-build (%guile-for-build))))
(build-derivations %store (list prof)) (build-derivations %store (list prof))
(string-match (format #f "^export XML_CATALOG_FILES=\"~a/xml/+bar/baz/catalog\\.xml\"\n" (string-match (format #f "^export XML_CATALOG_FILES=\"~a/xml/+bar/baz/catalog\\.xml\"\n"

View file

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