~ruther/guix-local

f304c9c237aca7e9007d6e0cefd6ed858c5a9e47 — Ludovic Courtès 11 years ago da74bc7
derivations: Raise an error for references to non-existent outputs.

Fixes <http://bugs.gnu.org/19630>.
Reported by Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de>.

* guix/derivations.scm (&derivation-error,
  &derivation-missing-output-error): New error conditions.
  (derivation->output-path): Raise a '&derivation-missing-output-error'
  if OUTPUT is not an output of DRV.
* guix/ui.scm (call-with-error-handling): Add case for
  'derivation-missing-output-error?'.
  (show-what-to-build): Check whether (derivation-outputs drv) is
  empty.
* tests/packages.scm ("reference to non-existent output"): Add test.
3 files changed, 47 insertions(+), 6 deletions(-)

M guix/derivations.scm
M guix/ui.scm
M tests/packages.scm
M guix/derivations.scm => guix/derivations.scm +30 -3
@@ 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."

M guix/ui.scm => guix/ui.scm +6 -3
@@ 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)))))


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