summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-05-10 22:46:19 +0200
committerLudovic Courtès <ludo@gnu.org>2013-05-10 22:46:19 +0200
commit94a4b3b9f289963949c197f846ec1882d75f5a1e (patch)
tree230832cb35b979b25068994ec9240f41960eb2c5
parent8c247e1c473d478287ebf2829475259ba3ee7780 (diff)
downloadguix-94a4b3b9f289963949c197f846ec1882d75f5a1e.tar.gz
package: Make sure the dependencies get built along with the manifest.
Before this, something like "guix package -i glibc" could fail because
glibc lists linux-libre-headers as a propagated input (which would be
added as a dependency in the manifest) but the linux-libre-headers
output could be unavailable, leading to an error like this:

  path `/nix/store/4v2bk8sx5cm166gks3fi3q7d9zchibnk-linux-libre-headers-3.3.8' is not valid

This patch adds such dependencies as inputs of the profile derivation.

* guix/scripts/package.scm (profile-derivation): Accept package objects
  in the `deps' field of an element of PACKAGES.  Convert them to their
  output path for BUILDER, and add them to the inputs of the
  `build-expression->derivation' call.
  (input->name+path): When INPUT doesn't contain a package object,
  return it as is.
  (guix-package)[process-actions](canonicalize-deps): Expect DEPS to
  contain package objects, and leave them as is.
-rw-r--r--guix/scripts/package.scm49
1 files changed, 35 insertions, 14 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 4018a34ed7..25ec63c772 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -157,6 +157,14 @@ case when generations have been deleted (there are \"holes\")."
 (define (profile-derivation store packages)
   "Return a derivation that builds a profile (a user environment) with
 all of PACKAGES, a list of name/version/output/path/deps tuples."
+  (define packages*
+    ;; Turn any package object in PACKAGES into its output path.
+    (map (match-lambda
+          ((name version output path (deps ...))
+           `(,name ,version ,output ,path
+                   ,(map input->name+path deps))))
+         packages))
+
   (define builder
     `(begin
        (use-modules (ice-9 pretty-print)
@@ -173,16 +181,26 @@ all of PACKAGES, a list of name/version/output/path/deps tuples."
          (call-with-output-file (string-append output "/manifest")
            (lambda (p)
              (pretty-print '(manifest (version 1)
-                                      (packages ,packages))
+                                      (packages ,packages*))
                            p))))))
 
+  (define ensure-valid-input
+    ;; If a package object appears in the given input, turn it into a
+    ;; derivation path.
+    (match-lambda
+     ((name (? package? p) sub-drv ...)
+      `(,name ,(package-derivation (%store) p) ,@sub-drv))
+     (input
+      input)))
+
   (build-expression->derivation store "user-environment"
                                 (%current-system)
                                 builder
                                 (append-map (match-lambda
                                              ((name version output path deps)
                                               `((,name ,path)
-                                                ,@deps)))
+                                                ,@(map ensure-valid-input
+                                                       deps))))
                                             packages)
                                 #:modules '((guix build union))))
 
@@ -256,15 +274,12 @@ matching packages."
   "Convert the name/package/sub-drv tuple INPUT to a name/store-path tuple."
   (let loop ((input input))
     (match input
-      ((name package)
+      ((name (? package? package))
        (loop `(,name ,package "out")))
-      ((name package sub-drv)
-       (let*-values (((_ drv)
-                      (package-derivation (%store) package))
-                     ((out)
-                      (derivation-output-path
-                       (assoc-ref (derivation-outputs drv) sub-drv))))
-         `(,name ,out))))))
+      ((name (? package? package) sub-drv)
+       `(,name ,(package-output (%store) package sub-drv)))
+      (_
+       input))))
 
 (define %sigint-prompt
   ;; The prompt to jump to upon SIGINT.
@@ -619,12 +634,18 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
       ;; where each input is a name/path tuple.
       (define (same? d1 d2)
         (match d1
-          ((_ path1)
+          ((_ p1)
+           (match d2
+             ((_ p2) (eq? p1 p2))
+             (_      #f)))
+          ((_ p1 out1)
            (match d2
-             ((_ path2)
-              (string=? path1 path2))))))
+             ((_ p2 out2)
+              (and (string=? out1 out2)
+                   (eq? p1 p2)))
+             (_ #f)))))
 
-      (delete-duplicates (map input->name+path deps) same?))
+      (delete-duplicates deps same?))
 
     (define (package->tuple p)
       (let ((path (package-derivation (%store) p))