~ruther/guix-local

5f7c5a97ba0a30b7fcdcbdf330efa4800c7bce90 — Ludovic Courtès 13 years ago 99d90fc
packages: Add `package-output'.

* guix/packages.scm (package-output): New procedure.
* tests/packages.scm ("package-output"): New test.
2 files changed, 21 insertions(+), 1 deletions(-)

M guix/packages.scm
M tests/packages.scm
M guix/packages.scm => guix/packages.scm +13 -0
@@ 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))))

M tests/packages.scm => tests/packages.scm +8 -1
@@ 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)