From 52ddf2ae6fb369ec64aae75fc311d6cc57a713b6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 19 May 2014 23:08:43 +0200
Subject: [PATCH] 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.
---
guix/ui.scm | 17 +++++++++--------
tests/ui.scm | 12 ++++++++++++
2 files changed, 21 insertions(+), 8 deletions(-)
diff --git a/guix/ui.scm b/guix/ui.scm
index 259dddd4810..48b5c745c62 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -261,6 +261,14 @@ (define* (show-what-to-build store drv
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 @@ (define* (show-what-to-build store drv
((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 886223ef546..4bf7a779c5a 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 @@ (define %paragraph
(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")
--
GitLab