futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ui: Gracefully deal with zero-output derivations.

Browse Source 
* 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:
Ludovic Courtès 2014-05-19 23:08:43 +02:00
parent 79b0d4e104
commit 52ddf2ae6f
2 changed files with 21 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
guix/ui.scm
View File

@ -261,6 +261,14 @@ error."
derivations listed in DRV. Return #t if there's something to build, #f derivations listed in DRV. Return #t if there's something to build, #f
otherwise. When USE-SUBSTITUTES?, check and report what is prerequisites are otherwise. When USE-SUBSTITUTES?, check and report what is prerequisites are
available for download." 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) (let*-values (((build download)
(fold2 (lambda (drv build download) (fold2 (lambda (drv build download)
(let-values (((b d) (let-values (((b d)
@ -275,14 +283,7 @@ available for download."
((build) ; add the DRV themselves ((build) ; add the DRV themselves
(delete-duplicates (delete-duplicates
(append (map derivation-file-name (append (map derivation-file-name
(remove (lambda (drv) (remove built-or-substitutable? drv))
(let ((out (derivation->output-path
drv)))
(or (valid-path? store out)
(and use-substitutes?
(has-substitutes? store
out)))))
drv))
(map derivation-input-path build)))) (map derivation-input-path build))))
((download) ; add the references of DOWNLOAD ((download) ; add the references of DOWNLOAD
(if use-substitutes? (if use-substitutes?

12
tests/ui.scm
View File

@ -19,6 +19,8 @@
(define-module (test-ui) (define-module (test-ui)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-19) #:use-module (srfi srfi-19)
#:use-module (srfi srfi-64)) #:use-module (srfi srfi-64))
@ -189,6 +191,16 @@ interface, and powerful string processing.")
(lambda args (lambda args
#t))) #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") (test-end "ui")