packages: Add `package-output'.

* guix/packages.scm (package-output): New procedure.
* tests/packages.scm ("package-output"): New test.
This commit is contained in:
Ludovic Courtès 2013-02-16 01:37:26 +01:00
parent 0228826262
commit d510ab4614
2 changed files with 21 additions and 1 deletions

View file

@ -20,10 +20,12 @@ (define-module (guix packages)
#:use-module (guix utils)
#:use-module (guix store)
#:use-module (guix base32)
#:use-module (guix derivations)
#:use-module (guix build-system)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:re-export (%current-system)
@ -62,6 +64,7 @@ (define-module (guix packages)
package-source-derivation
package-derivation
package-cross-derivation
package-output
&package-error
package-error?
@ -305,3 +308,13 @@ (define expand-input
(define* (package-cross-derivation store package)
;; TODO
#f)
(define* (package-output store package output
#:optional (system (%current-system)))
"Return the output path of PACKAGE's OUTPUT for SYSTEM---where OUTPUT is the
symbolic output name, such as \"out\". Note that this procedure calls
`package-derivation', which is costly."
(let-values (((_ drv)
(package-derivation store package system)))
(derivation-output-path
(assoc-ref (derivation-outputs drv) output))))

View file

@ -71,7 +71,7 @@ (define-syntax-rule (dummy-package name* extra-fields ...)
("d" ,d) ("d/x" "something.drv"))
(pk 'x (package-transitive-inputs e))))))
(test-skip (if (not %store) 3 0))
(test-skip (if (not %store) 4 0))
(test-assert "return values"
(let-values (((drv-path drv)
@ -79,6 +79,13 @@ (define-syntax-rule (dummy-package name* extra-fields ...)
(and (derivation-path? drv-path)
(derivation? drv))))
(test-assert "package-output"
(let* ((package (dummy-package "p"))
(drv-path (package-derivation %store package)))
(and (derivation-path? drv-path)
(string=? (derivation-path->output-path drv-path)
(package-output %store package "out")))))
(test-assert "trivial"
(let* ((p (package (inherit (dummy-package "trivial"))
(build-system trivial-build-system)