summaryrefslogtreecommitdiff
path: root/guix/derivations.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-03-24 22:47:25 +0100
committerLudovic Courtès <ludo@gnu.org>2015-03-24 23:22:23 +0100
commitc7d1d88f6c75f9ba67caa624976dbad2980856ef (patch)
tree3e0ad90854b1fd1e6485e0f76a2ba5b7e5836c97 /guix/derivations.scm
parentb655b2154c8a72f5c9b7e54594653df49f3c2c02 (diff)
derivations: Don't invoke the substituter when an item is already in store.
Fixes <http://bugs.gnu.org/20188>. Reported by Mark H Weaver <mhw@netris.org>. * guix/derivations.scm (substitution-oracle): Add 'valid?' procedure. Remove 'valid?' items from PATHS.
Diffstat (limited to 'guix/derivations.scm')
-rw-r--r--guix/derivations.scm20
1 files changed, 13 insertions, 7 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 4b0048b54b..9b5ee367b6 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -225,22 +225,28 @@ download with a fixed hash (aka. `fetchurl')."
(define* (substitution-oracle store drv)
"Return a one-argument procedure that, when passed a store file name,
returns #t if it's substitutable and #f otherwise. The returned procedure
-knows about all substitutes for all the derivations listed in DRV and their
-prerequisites.
+knows about all substitutes for all the derivations listed in DRV; it also
+knows about their prerequisites, unless they are themselves substitutable.
Creating a single oracle (thus making a single 'substitutable-paths' call) and
reusing it is much more efficient than calling 'has-substitutes?' or similar
repeatedly, because it avoids the costs associated with launching the
substituter many times."
+ (define valid?
+ (cut valid-path? store <>))
+
(let* ((paths (delete-duplicates
(fold (lambda (drv result)
(let ((self (match (derivation->output-paths drv)
(((names . paths) ...)
- paths)))
- (deps (append-map derivation-input-output-paths
- (derivation-prerequisites
- drv))))
- (append self deps result)))
+ paths))))
+ (if (every valid? self)
+ result
+ (let ((deps
+ (append-map derivation-input-output-paths
+ (derivation-prerequisites drv))))
+ (append (remove valid? (append self deps))
+ result)))))
'()
drv)))
(subst (list->set (substitutable-paths store paths))))