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.
This commit is contained in:
Ludovic Courtès 2013-05-10 22:46:19 +02:00
parent 8c247e1c47
commit 94a4b3b9f2
1 changed files with 35 additions and 14 deletions

View File

@ -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
((_ path2)
(string=? path1 path2))))))
((_ p2) (eq? p1 p2))
(_ #f)))
((_ p1 out1)
(match d2
((_ 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))