From 784bb1f37bfe7efd0c31fdcf207b0459f4edc7bf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <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.
---
 tests/derivations.scm | 38 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)

(limited to 'tests/derivations.scm')

diff --git a/tests/derivations.scm b/tests/derivations.scm
index 061a9bd42b..119edfcb86 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -353,6 +353,44 @@
     ;; built.
     (null? (derivation-prerequisites-to-build %store drv))))
 
+(test-assert "derivation-prerequisites-to-build when outputs already present"
+  (let*-values (((builder)
+                 '(begin (mkdir %output) #t))
+                ((input-drv-path input-drv)
+                 (build-expression->derivation %store "input"
+                                               (%current-system)
+                                               builder '()))
+                ((input-path)
+                 (derivation-output-path
+                  (assoc-ref (derivation-outputs input-drv)
+                             "out")))
+                ((drv-path drv)
+                 (build-expression->derivation %store "something"
+                                               (%current-system)
+                                               builder
+                                               `(("i" ,input-drv-path))))
+                ((output)
+                 (derivation-output-path
+                  (assoc-ref (derivation-outputs drv) "out"))))
+    ;; Make sure these things are not already built.
+    (when (valid-path? %store input-path)
+      (delete-paths %store (list input-path)))
+    (when (valid-path? %store output)
+      (delete-paths %store (list output)))
+
+    (and (equal? (map derivation-input-path
+                      (derivation-prerequisites-to-build %store drv))
+                 (list input-drv-path))
+
+         ;; Build DRV and delete its input.
+         (build-derivations %store (list drv-path))
+         (delete-paths %store (list input-path))
+         (not (valid-path? %store input-path))
+
+         ;; Now INPUT-PATH is missing, yet it shouldn't be listed as a
+         ;; prerequisite to build because DRV itself is already built.
+         (null? (derivation-prerequisites-to-build %store drv)))))
+
 (test-assert "build-expression->derivation with expression returning #f"
   (let* ((builder  '(begin
                       (mkdir %output)
-- 
cgit v1.2.3