aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/derivations.scm33
-rw-r--r--guix/ui.scm9
-rw-r--r--tests/packages.scm11
3 files changed, 47 insertions, 6 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 4c34fcb4b8..edf6b57e86 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -21,6 +21,8 @@
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
#:use-module (rnrs io ports)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
@@ -59,6 +61,13 @@
derivation-input-sub-derivations
derivation-input-output-paths
+ &derivation-error
+ derivation-error?
+ derivation-error-derivation
+ &derivation-missing-output-error
+ derivation-missing-output-error?
+ derivation-missing-output
+
derivation-name
derivation-output-names
fixed-output-derivation?
@@ -98,6 +107,18 @@
#:replace (build-derivations))
;;;
+;;; Error conditions.
+;;;
+
+(define-condition-type &derivation-error &nix-error
+ derivation-error?
+ (derivation derivation-error-derivation))
+
+(define-condition-type &derivation-missing-output-error &derivation-error
+ derivation-missing-output-error?
+ (output derivation-missing-output))
+
+;;;
;;; Nix derivations, as implemented in Nix's `derivations.cc'.
;;;
@@ -509,9 +530,15 @@ that form."
(cut write-derivation drv <>))))))
(define* (derivation->output-path drv #:optional (output "out"))
- "Return the store path of its output OUTPUT."
- (let ((outputs (derivation-outputs drv)))
- (and=> (assoc-ref outputs output) derivation-output-path)))
+ "Return the store path of its output OUTPUT. Raise a
+'&derivation-missing-output-error' condition if OUTPUT is not an output of
+DRV."
+ (let ((output* (assoc-ref (derivation-outputs drv) output)))
+ (if output*
+ (derivation-output-path output*)
+ (raise (condition (&derivation-missing-output-error
+ (derivation drv)
+ (output output)))))))
(define (derivation->output-paths drv)
"Return the list of name/path pairs of the outputs of DRV."
diff --git a/guix/ui.scm b/guix/ui.scm
index e1e75d8556..04c50f4827 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -249,6 +249,10 @@ interpreted."
;; FIXME: Server-provided error messages aren't i18n'd.
(leave (_ "build failed: ~a~%")
(nix-protocol-error-message c)))
+ ((derivation-missing-output-error? c)
+ (leave (_ "reference to invalid output '~a' of derivation '~a'~%")
+ (derivation-missing-output c)
+ (derivation-file-name (derivation-error-derivation c))))
((message-condition? c)
;; Normally '&message' error conditions have an i18n'd message.
(leave (_ "~a~%")
@@ -309,9 +313,8 @@ available for download."
(const #f)))
(define (built-or-substitutable? drv)
- (let ((out (derivation->output-path drv)))
- ;; If DRV has zero outputs, OUT is #f.
- (or (not out)
+ (or (null? (derivation-outputs drv))
+ (let ((out (derivation->output-path drv))) ;XXX: assume "out" exists
(or (valid-path? store out)
(substitutable? out)))))
diff --git a/tests/packages.scm b/tests/packages.scm
index ef34e76380..65e5cc3cdd 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -268,6 +268,17 @@
(package-derivation %store p)
#f)))
+(test-assert "reference to non-existent output"
+ ;; See <http://bugs.gnu.org/19630>.
+ (let* ((dep (dummy-package "dep"))
+ (p (dummy-package "p"
+ (inputs `(("dep" ,dep "non-existent"))))))
+ (guard (c ((derivation-missing-output-error? c)
+ (and (string=? (derivation-missing-output c) "non-existent")
+ (equal? (package-derivation %store dep)
+ (derivation-error-derivation c)))))
+ (package-derivation %store p))))
+
(test-assert "trivial"
(let* ((p (package (inherit (dummy-package "trivial"))
(build-system trivial-build-system)