01/01: derivations: Don't invoke the substituter when an item is already in store.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit c7d1d88f6c75f9ba67caa624976dbad2980856ef
Author: Ludovic Courtès <address@hidden>
Date:   Tue Mar 24 22:47:25 2015 +0100

    derivations: Don't invoke the substituter when an item is already in store.
    
    Fixes <http://bugs.gnu.org/20188>.
    Reported by Mark H Weaver <address@hidden>.
    
    * guix/derivations.scm (substitution-oracle): Add 'valid?' procedure.
      Remove 'valid?' items from PATHS.
---
 guix/derivations.scm |   20 +++++++++++++-------
 1 files changed, 13 insertions(+), 7 deletions(-)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 4b0048b..9b5ee36 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))))