diff options
| -rw-r--r-- | guix/profiles.scm | 17 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 23 | ||||
| -rw-r--r-- | tests/profiles.scm | 27 |
3 files changed, 49 insertions, 18 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm index 96c8ca0514..5e69e012f9 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -51,6 +51,7 @@ manifest-matching-entries profile-manifest + package->manifest-entry profile-derivation generation-number generation-numbers @@ -105,6 +106,22 @@ (call-with-input-file file read-manifest) (manifest '())))) +(define* (package->manifest-entry package #:optional output) + "Return a manifest entry for the OUTPUT of package PACKAGE. When OUTPUT is +omitted or #f, use the first output of PACKAGE." + (let ((deps (map (match-lambda + ((label package) + `(,package "out")) + ((label package output) + `(,package ,output))) + (package-transitive-propagated-inputs package)))) + (manifest-entry + (name (package-name package)) + (version (package-version package)) + (output (or output (car (package-outputs package)))) + (item package) + (dependencies (delete-duplicates deps))))) + (define (manifest->gexp manifest) "Return a representation of MANIFEST as a gexp." (define (entry->gexp entry) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 3fe7385bc2..31da773a53 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -641,24 +641,11 @@ return the new list of manifest entries." (delete-duplicates deps same?)) - (define (package->manifest-entry p output) - ;; Return a manifest entry for the OUTPUT of package P. - (check-package-freshness p) + (define (package->manifest-entry* package output) + (check-package-freshness package) ;; When given a package via `-e', install the first of its ;; outputs (XXX). - (let* ((output (or output (car (package-outputs p)))) - (deps (map (match-lambda - ((label package) - `(,package "out")) - ((label package output) - `(,package ,output))) - (package-transitive-propagated-inputs p)))) - (manifest-entry - (name (package-name p)) - (version (package-version p)) - (output output) - (item p) - (dependencies (delete-duplicates deps))))) + (package->manifest-entry package output)) (define upgrade-regexps (filter-map (match-lambda @@ -689,7 +676,7 @@ return the new list of manifest entries." (define to-upgrade (map (match-lambda ((package output) - (package->manifest-entry package output))) + (package->manifest-entry* package output))) packages-to-upgrade)) (define packages-to-install @@ -707,7 +694,7 @@ return the new list of manifest entries." (define to-install (append (map (match-lambda ((package output) - (package->manifest-entry package output))) + (package->manifest-entry* package output))) packages-to-install) (filter-map (match-lambda (('install . (? package?)) diff --git a/tests/profiles.scm b/tests/profiles.scm index e6fcaad7cf..d405f6453e 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -18,11 +18,25 @@ (define-module (test-profiles) #:use-module (guix profiles) + #:use-module (guix store) + #:use-module (guix monads) + #:use-module (guix packages) + #:use-module (guix derivations) + #:use-module (gnu packages bootstrap) #:use-module (ice-9 match) #:use-module (srfi srfi-64)) ;; Test the (guix profile) module. +(define %store + (open-connection)) + +(define guile-for-build + (package-derivation %store %bootstrap-guile)) + +;; Make it the default. +(%guile-for-build guile-for-build) + ;; Example manifest entries. @@ -87,6 +101,19 @@ (null? (manifest-entries m3)) (null? (manifest-entries m4))))))) +(test-assert "profile-derivation" + (run-with-store %store + (mlet* %store-monad + ((entry -> (package->manifest-entry %bootstrap-guile)) + (guile (package->derivation %bootstrap-guile)) + (drv (profile-derivation (manifest (list entry)))) + (profile -> (derivation->output-path drv)) + (bindir -> (string-append profile "/bin")) + (_ (built-derivations (list drv)))) + (return (and (file-exists? (string-append bindir "/guile")) + (string=? (dirname (readlink bindir)) + (derivation->output-path guile))))))) + (test-end "profiles") |