[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
04/08: derivations: 'derivation-prerequisites-to-build' returns <substit
From: |
Ludovic Courtès |
Subject: |
04/08: derivations: 'derivation-prerequisites-to-build' returns <substitutable>. |
Date: |
Fri, 2 Jun 2017 12:48:16 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 2dc98729afb62e48b5866f599df9a9274d440686
Author: Ludovic Courtès <address@hidden>
Date: Wed May 31 11:06:42 2017 +0200
derivations: 'derivation-prerequisites-to-build' returns <substitutable>.
* guix/derivations.scm (derivation-prerequisites-to-build): Rename
#:substitutable? to #:substitutable-info.
[derivation-substitutable?]: Rename to...
[derivation-substitutable-info]: ... this. Return a list of
<substitutable>.
Second return value is now a list of <substitutable> instead of a list
of strings.
* guix/ui.scm (show-what-to-build)[substitutable?]: Rename to...
[substitutable-info]: ... this.
Adjust to new 'derivation-prerequisites-to-build' return value type.
* tests/derivations.scm ("derivation-prerequisites-to-build and
substitutes"): Adjust.
("derivation-prerequisites-to-build and substitutes, local build"):
Likewise.
---
guix/derivations.scm | 31 ++++++++++++++++++-------------
guix/ui.scm | 25 +++++++++++++++----------
tests/derivations.scm | 6 +++---
3 files changed, 36 insertions(+), 26 deletions(-)
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 5e457f1..b9ad9c9 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -334,13 +334,13 @@ substituter many times."
(mode (build-mode normal))
(outputs
(derivation-output-names drv))
- (substitutable?
+ (substitutable-info
(substitution-oracle store
(list drv)
#:mode
mode)))
"Return two values: the list of derivation-inputs required to build the
OUTPUTS of DRV and not already available in STORE, recursively, and the list
-of required store paths that can be substituted. SUBSTITUTABLE? must be a
+of required store paths that can be substituted. SUBSTITUTABLE-INFO must be a
one-argument procedure similar to that returned by 'substitution-oracle'."
(define built?
(cut valid-path? store <>))
@@ -351,7 +351,7 @@ one-argument procedure similar to that returned by
'substitution-oracle'."
(define input-substitutable?
;; Return true if and only if all of SUB-DRVS are subsitutable. If at
;; least one is missing, then everything must be rebuilt.
- (compose (cut every substitutable? <>) derivation-input-output-paths))
+ (compose (cut every substitutable-info <>) derivation-input-output-paths))
(define (derivation-built? drv* sub-drvs)
;; In 'check' mode, assume that DRV is not built.
@@ -359,20 +359,24 @@ one-argument procedure similar to that returned by
'substitution-oracle'."
(eq? drv* drv)))
(every built? (derivation-output-paths drv* sub-drvs))))
- (define (derivation-substitutable? drv sub-drvs)
+ (define (derivation-substitutable-info drv sub-drvs)
(and (substitutable-derivation? drv)
- (every substitutable? (derivation-output-paths drv sub-drvs))))
+ (let ((info (filter-map substitutable-info
+ (derivation-output-paths drv sub-drvs))))
+ (and (= (length info) (length sub-drvs))
+ info))))
(let loop ((drv drv)
(sub-drvs outputs)
- (build '())
- (substitute '()))
+ (build '()) ;list of <derivation-input>
+ (substitute '())) ;list of <substitutable>
(cond ((derivation-built? drv sub-drvs)
(values build substitute))
- ((derivation-substitutable? drv sub-drvs)
- (values build
- (append (derivation-output-paths drv sub-drvs)
- substitute)))
+ ((derivation-substitutable-info drv sub-drvs)
+ =>
+ (lambda (substitutables)
+ (values build
+ (append substitutables substitute))))
(else
(let ((build (if (substitutable-derivation? drv)
build
@@ -389,8 +393,9 @@ one-argument procedure similar to that returned by
'substitution-oracle'."
(append (append-map (lambda (input)
(if (and (not (input-built? input))
(input-substitutable?
input))
- (derivation-input-output-paths
- input)
+ (map substitutable-info
+
(derivation-input-output-paths
+ input))
'()))
(derivation-inputs drv))
substitute)
diff --git a/guix/ui.scm b/guix/ui.scm
index 9e0fa26..9b64648 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -588,7 +588,7 @@ error."
derivations listed in DRV using MODE, a 'build-mode' value. Return #t if
there's something to build, #f otherwise. When USE-SUBSTITUTES?, check and
report what is prerequisites are available for download."
- (define substitutable?
+ (define substitutable-info
;; Call 'substitutation-oracle' upfront so we don't end up launching the
;; substituter many times. This makes a big difference, especially when
;; DRV is a long list as is the case with 'guix environment'.
@@ -600,7 +600,7 @@ report what is prerequisites are available for download."
(or (null? (derivation-outputs drv))
(let ((out (derivation->output-path drv))) ;XXX: assume "out" exists
(or (valid-path? store out)
- (substitutable? out)))))
+ (substitutable-info out)))))
(let*-values (((build download)
(fold2 (lambda (drv build download)
@@ -608,7 +608,8 @@ report what is prerequisites are available for download."
(derivation-prerequisites-to-build
store drv
#:mode mode
- #:substitutable? substitutable?)))
+ #:substitutable-info
+ substitutable-info)))
(values (append b build)
(append d download))))
'() '()
@@ -622,11 +623,13 @@ report what is prerequisites are available for download."
(if use-substitutes?
(delete-duplicates
(append download
- (remove (cut valid-path? store <>)
- (append-map
- substitutable-references
- (substitutable-path-info store
- download)))))
+ (filter-map (lambda (item)
+ (if (valid-path? store item)
+ #f
+ (substitutable-info item)))
+ (append-map
+ substitutable-references
+ download))))
download)))
;; TODO: Show the installed size of DOWNLOAD.
(if dry-run?
@@ -640,7 +643,8 @@ report what is prerequisites are available for download."
(N_ "~:[The following file would be downloaded:~%~{
~a~%~}~;~]"
"~:[The following files would be downloaded:~%~{
~a~%~}~;~]"
(length download))
- (null? download) download))
+ (null? download)
+ (map substitutable-path download)))
(begin
(format (current-error-port)
(N_ "~:[The following derivation will be built:~%~{
~a~%~}~;~]"
@@ -651,7 +655,8 @@ report what is prerequisites are available for download."
(N_ "~:[The following file will be downloaded:~%~{
~a~%~}~;~]"
"~:[The following files will be downloaded:~%~{
~a~%~}~;~]"
(length download))
- (null? download) download)))
+ (null? download)
+ (map substitutable-path download))))
(pair? build)))
(define show-what-to-build*
diff --git a/tests/derivations.scm b/tests/derivations.scm
index d4e1a32..f3aad1b 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -831,10 +831,10 @@
(derivation-prerequisites-to-build store drv))
((build* download*)
(derivation-prerequisites-to-build store drv
- #:substitutable?
+ #:substitutable-info
(const #f))))
(and (null? build)
- (equal? download (list output))
+ (equal? (map substitutable-path download) (list output))
(null? download*)
(null? build*))))))
@@ -879,7 +879,7 @@
;; See <http://bugs.gnu.org/18747>.
(and (null? build)
(match download
- (((? string? item))
+ (((= substitutable-path item))
(string=? item (derivation->output-path drv))))))))))
(test-assert "derivation-prerequisites-to-build in 'check' mode"
- branch master updated (835a658 -> 36a9d3f), Ludovic Courtès, 2017/06/02
- 03/08: derivations: 'substitution-oracle' returns a <substitutable>., Ludovic Courtès, 2017/06/02
- 08/08: substitute: Do not display the installed size., Ludovic Courtès, 2017/06/02
- 05/08: ui: 'show-what-to-build' displays how much will be downloaded., Ludovic Courtès, 2017/06/02
- 01/08: tests: Remove 't-profile-alt-*-link' files., Ludovic Courtès, 2017/06/02
- 04/08: derivations: 'derivation-prerequisites-to-build' returns <substitutable>.,
Ludovic Courtès <=
- 02/08: gnu: Move vtk to image-processing.scm., Ludovic Courtès, 2017/06/02
- 06/08: syscalls: Provide 'free-disk-space'., Ludovic Courtès, 2017/06/02
- 07/08: ui: 'show-what-to-build' warns when we don't have enough disk space., Ludovic Courtès, 2017/06/02