summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-05-19 23:08:43 +0200
committerLudovic Courtès <ludo@gnu.org>2014-05-19 23:52:40 +0200
commit52ddf2ae6fb369ec64aae75fc311d6cc57a713b6 (patch)
tree7b7f02838ff6367b4819f6238a85f4fc98e7461e
parent79b0d4e1049afe1ceb5d420a9ceb11c230a1da24 (diff)
ui: Gracefully deal with zero-output derivations.
* guix/ui.scm (show-what-to-build)[built-or-substitutable?]: New procedure. Check whether OUT is #f. Use it. * tests/ui.scm ("show-what-to-build, zero outputs"): New test.
-rw-r--r--guix/ui.scm17
-rw-r--r--tests/ui.scm12
2 files changed, 21 insertions, 8 deletions
diff --git a/guix/ui.scm b/guix/ui.scm
index 259dddd481..48b5c745c6 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -261,6 +261,14 @@ error."
derivations listed in DRV. Return #t if there's something to build, #f
otherwise. When USE-SUBSTITUTES?, check and report what is prerequisites are
available for download."
+ (define (built-or-substitutable? drv)
+ (let ((out (derivation->output-path drv)))
+ ;; If DRV has zero outputs, OUT is #f.
+ (or (not out)
+ (or (valid-path? store out)
+ (and use-substitutes?
+ (has-substitutes? store out))))))
+
(let*-values (((build download)
(fold2 (lambda (drv build download)
(let-values (((b d)
@@ -275,14 +283,7 @@ available for download."
((build) ; add the DRV themselves
(delete-duplicates
(append (map derivation-file-name
- (remove (lambda (drv)
- (let ((out (derivation->output-path
- drv)))
- (or (valid-path? store out)
- (and use-substitutes?
- (has-substitutes? store
- out)))))
- drv))
+ (remove built-or-substitutable? drv))
(map derivation-input-path build))))
((download) ; add the references of DOWNLOAD
(if use-substitutes?
diff --git a/tests/ui.scm b/tests/ui.scm
index 886223ef54..4bf7a779c5 100644
--- a/tests/ui.scm
+++ b/tests/ui.scm
@@ -19,6 +19,8 @@
(define-module (test-ui)
#:use-module (guix ui)
+ #:use-module (guix store)
+ #:use-module (guix derivations)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-64))
@@ -189,6 +191,16 @@ interface, and powerful string processing.")
(lambda args
#t)))
+(test-equal "show-what-to-build, zero outputs"
+ ""
+ (with-store store
+ (let ((drv (derivation store "zero" "/bin/sh" '()
+ #:outputs '())))
+ (with-error-to-string
+ (lambda ()
+ ;; This should print nothing.
+ (show-what-to-build store (list drv)))))))
+
(test-end "ui")