diff options
| -rw-r--r-- | guix/packages.scm | 13 | ||||
| -rw-r--r-- | tests/packages.scm | 9 |
2 files changed, 21 insertions, 1 deletions
diff --git a/guix/packages.scm b/guix/packages.scm index b372f03818..51984baa3b 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -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)))) diff --git a/tests/packages.scm b/tests/packages.scm index 32ee558518..f441532d22 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -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) |