From 784bb1f37bfe7efd0c31fdcf207b0459f4edc7bf Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 9 Jan 2013 08:38:57 +0100
Subject: derivations: Fix `derivation-prerequisites-to-build' when outputs are
 there.

Before it would list inputs not built, even if the outputs of the given
derivation were already available.

* guix/derivations.scm (derivation-prerequisites-to-build): Add
  `outputs' keyword parameter.
  [built?, derivation-built?]: New procedures.
  [loop]: Add `sub-drvs' parameter.  Use `derivation-built?' to check if
  the SUB-DRVS of DRV are built before checking its inputs.
---
 guix/derivations.scm | 52 ++++++++++++++++++++++++++++++++++++----------------
 1 file changed, 36 insertions(+), 16 deletions(-)

(limited to 'guix/derivations.scm')

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 7b131955b0..ce8858a2fa 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -112,28 +112,48 @@ download with a fixed hash (aka. `fetchurl')."
                      read-derivation))
                  inputs)))))
 
-(define (derivation-prerequisites-to-build store drv)
-  "Return the list of derivation-inputs required to build DRV and not already
-available in STORE, recursively."
+(define* (derivation-prerequisites-to-build store drv
+                                            #:key (outputs
+                                                   (map
+                                                    car
+                                                    (derivation-outputs drv))))
+  "Return the list of derivation-inputs required to build the OUTPUTS of
+DRV and not already available in STORE, recursively."
+  (define built?
+    (cut valid-path? store <>))
+
   (define input-built?
     (match-lambda
      (($ <derivation-input> path sub-drvs)
       (let ((out (map (cut derivation-path->output-path path <>)
                       sub-drvs)))
-        (any (cut valid-path? store <>) out)))))
+        (any built? out)))))
 
-  (let loop ((drv    drv)
-             (result '()))
-    (let ((inputs (remove (lambda (i)
-                            (or (member i result) ; XXX: quadratic
-                                (input-built? i)))
-                          (derivation-inputs drv))))
-      (fold loop
-            (append inputs result)
-            (map (lambda (i)
-                   (call-with-input-file (derivation-input-path i)
-                     read-derivation))
-                 inputs)))))
+  (define (derivation-built? drv sub-drvs)
+    (match drv
+      (($ <derivation> outputs)
+       (let ((paths (map (lambda (sub-drv)
+                           (derivation-output-path
+                            (assoc-ref outputs sub-drv)))
+                         sub-drvs)))
+         (every built? paths)))))
+
+  (let loop ((drv      drv)
+             (sub-drvs outputs)
+             (result   '()))
+    (if (derivation-built? drv sub-drvs)
+        result
+        (let ((inputs (remove (lambda (i)
+                                (or (member i result) ; XXX: quadratic
+                                    (input-built? i)))
+                              (derivation-inputs drv))))
+          (fold loop
+                (append inputs result)
+                (map (lambda (i)
+                       (call-with-input-file (derivation-input-path i)
+                         read-derivation))
+                     inputs)
+                (map derivation-input-sub-derivations inputs))))))
 
 (define (read-derivation drv-port)
   "Read the derivation from DRV-PORT and return the corresponding
-- 
cgit v1.2.3