aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-05-31 11:06:42 +0200
committerLudovic Courtès <ludo@gnu.org>2017-06-02 18:47:06 +0200
commit2dc98729afb62e48b5866f599df9a9274d440686 (patch)
treea72a66bb34e6bb309bf93dfc89523a63b5685b41
parentef51ac21eec28de3b0fb693f88be5f3c494d464a (diff)
downloadpatches-2dc98729afb62e48b5866f599df9a9274d440686.tar
patches-2dc98729afb62e48b5866f599df9a9274d440686.tar.gz
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.
-rw-r--r--guix/derivations.scm31
-rw-r--r--guix/ui.scm25
-rw-r--r--tests/derivations.scm6
3 files changed, 36 insertions, 26 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 5e457f1893..b9ad9c9e8c 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 9e0fa26d19..9b64648964 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 d4e1a32bb6..f3aad1b906 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"