Browse Source

packages: Add `package-output'.

* guix/packages.scm (package-output): New procedure.
* tests/packages.scm ("package-output"): New test.
gn-latest-20200428
Ludovic Courtès 9 years ago
parent
commit
d510ab4614
2 changed files with 21 additions and 1 deletions
  1. +13
    -0
      guix/packages.scm
  2. +8
    -1
      tests/packages.scm

+ 13
- 0
guix/packages.scm View File

@ -20,10 +20,12 @@
#: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 @@
package-source-derivation
package-derivation
package-cross-derivation
package-output
&package-error
package-error?
@ -305,3 +308,13 @@ PACKAGE for SYSTEM."
(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))))

+ 8
- 1
tests/packages.scm View File

@ -71,7 +71,7 @@
("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 @@
(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)


Loading…
Cancel
Save