3 files changed, 49 insertions(+), 18 deletions(-)

M guix/profiles.scm
M guix/scripts/package.scm
M tests/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)

@@ 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?))

@@ 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")