mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
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.
This commit is contained in:
parent
79b0d4e104
commit
52ddf2ae6f
2 changed files with 21 additions and 8 deletions
17
guix/ui.scm
17
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?
|
||||
|
|
12
tests/ui.scm
12
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")
|
||||
|
||||
|
||||
|
|
Loading…
Reference in a new issue