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 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (guix derivations)
#:use-module (guix build-system) #:use-module (guix build-system)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (srfi srfi-35) #:use-module (srfi srfi-35)
#:re-export (%current-system) #:re-export (%current-system)
@ -62,6 +64,7 @@
package-source-derivation package-source-derivation
package-derivation package-derivation
package-cross-derivation package-cross-derivation
package-output
&package-error &package-error
package-error? package-error?
@ -305,3 +308,13 @@ PACKAGE for SYSTEM."
(define* (package-cross-derivation store package) (define* (package-cross-derivation store package)
;; TODO ;; TODO
#f) #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 @@
("d" ,d) ("d/x" "something.drv")) ("d" ,d) ("d/x" "something.drv"))
(pk 'x (package-transitive-inputs e)))))) (pk 'x (package-transitive-inputs e))))))
(test-skip (if (not %store) 3 0)) (test-skip (if (not %store) 4 0))
(test-assert "return values" (test-assert "return values"
(let-values (((drv-path drv) (let-values (((drv-path drv)
@ -79,6 +79,13 @@
(and (derivation-path? drv-path) (and (derivation-path? drv-path)
(derivation? drv)))) (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" (test-assert "trivial"
(let* ((p (package (inherit (dummy-package "trivial")) (let* ((p (package (inherit (dummy-package "trivial"))
(build-system trivial-build-system) (build-system trivial-build-system)