From b1510fd8d252c1ab0d32a32f064513105b99cf39 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 4 Jul 2019 23:09:11 +0200
Subject: [PATCH] derivations: 'derivation-build-plan' recurses on
 substituables.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This fixes a bug whereby "guix build texlive -n" would report:

  0.0 MB would be downloaded:
     /gnu/store/…-texlive-20180414

instead of:

  The following derivation would be built:
     /gnu/store/…-texlive-texmf-20180414.drv
  2,595.2 MB would be downloaded:
     /gnu/store/…-texlive-20180414-texmf.tar.xz
     /gnu/store/…-texlive-20180414

where 'texlive-texmf' is a non-substitutable dependency of 'texlive'.

* guix/derivations.scm (dependencies-of-substitutables): New procedure.
(derivation-build-plan): When 'input-substitutable-info' returns true,
append the subset of DEPS that corresponds to SUBSTITUABLES to the first
argument of 'loop'.
* guix/ui.scm (show-what-to-build): Remove half-baked traversal of
DOWNLOAD.
* tests/derivations.scm ("derivation-build-plan and substitutes,
non-substitutable dep"): New test.
---
 guix/derivations.scm  | 29 +++++++++++++++++++++--------
 guix/ui.scm           | 12 ------------
 tests/derivations.scm | 29 +++++++++++++++++++++++++++++
 3 files changed, 50 insertions(+), 20 deletions(-)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 186d7a3f8f..caa76bd16c 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -352,6 +352,16 @@ substituter many times."
         (#f #f)
         ((key . value) value)))))
 
+(define (dependencies-of-substitutables substitutables inputs)
+  "Return the subset of INPUTS whose output file names is among the references
+of SUBSTITUTABLES."
+  (let ((items (fold set-insert (set)
+                     (append-map substitutable-references substitutables))))
+    (filter (lambda (input)
+              (any (cut set-contains? items <>)
+                   (derivation-input-output-paths input)))
+            inputs)))
+
 (define* (derivation-build-plan store inputs
                                 #:key
                                 (mode (build-mode normal))
@@ -391,7 +401,9 @@ by 'substitution-oracle'."
       (()
        (values build substitute))
       ((input rest ...)
-       (let ((key (derivation-input-key input)))
+       (let ((key  (derivation-input-key input))
+             (deps (derivation-inputs
+                    (derivation-input-derivation input))))
          (cond ((set-contains? visited key)
                 (loop rest build substitute visited))
                ((input-built? input)
@@ -400,16 +412,17 @@ by 'substitution-oracle'."
                ((input-substitutable-info input)
                 =>
                 (lambda (substitutables)
-                  (loop rest build
+                  (loop (append (dependencies-of-substitutables substitutables
+                                                                deps)
+                                rest)
+                        build
                         (append substitutables substitute)
                         (set-insert key visited))))
                (else
-                (let ((deps (derivation-inputs
-                             (derivation-input-derivation input))))
-                  (loop (append deps rest)
-                        (cons (derivation-input-derivation input) build)
-                        substitute
-                        (set-insert key visited))))))))))
+                (loop (append deps rest)
+                      (cons (derivation-input-derivation input) build)
+                      substitute
+                      (set-insert key visited)))))))))
 
 (define-deprecated (derivation-prerequisites-to-build store drv #:rest rest)
   derivation-build-plan
diff --git a/guix/ui.scm b/guix/ui.scm
index 6d243ef041..2ce82ff658 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -844,18 +844,6 @@ check and report what is prerequisites are available for download."
                                         #:mode mode
                                         #:substitutable-info
                                         substitutable-info))
-                ((download)                   ; add the references of DOWNLOAD
-                 (if use-substitutes?
-                     (delete-duplicates
-                      (append download
-                              (filter-map (lambda (item)
-                                            (if (valid-path? store item)
-                                                #f
-                                                (substitutable-info item)))
-                                          (append-map
-                                           substitutable-references
-                                           download))))
-                     download))
                 ((graft hook build)
                  (match (fold (lambda (drv acc)
                                 (let ((file (derivation-file-name drv)))
diff --git a/tests/derivations.scm b/tests/derivations.scm
index d173a78906..7be7726163 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -896,6 +896,35 @@
                (((= derivation-file-name build))
                 (string=? build (derivation-file-name drv)))))))))
 
+(test-assert "derivation-build-plan and substitutes, non-substitutable dep"
+  (with-store store
+    (let* ((drv1 (build-expression->derivation store "prereq-no-subst"
+                                               (random 1000)
+                                               #:substitutable? #f))
+           (drv2 (build-expression->derivation store "substitutable"
+                                               (random 1000)
+                                               #:inputs `(("dep" ,drv1)))))
+
+      ;; Make sure substitutes are usable.
+      (set-build-options store #:use-substitutes? #t
+                         #:substitute-urls (%test-substitute-urls))
+
+      (with-derivation-narinfo drv2
+        (sha256 => (make-bytevector 32 0))
+        (references => (list (derivation->output-path drv1)))
+
+        (let-values (((build download)
+                      (derivation-build-plan store
+                                             (list (derivation-input drv2)))))
+          ;; Although DRV2 is available as a substitute, we must build its
+          ;; dependency, DRV1, due to #:substitutable? #f.
+          (and (match download
+                 (((= substitutable-path item))
+                  (string=? item (derivation->output-path drv2))))
+               (match build
+                 (((= derivation-file-name build))
+                  (string=? build (derivation-file-name drv1))))))))))
+
 (test-assert "derivation-build-plan and substitutes, local build"
   (with-store store
     (let* ((drv    (build-expression->derivation store "prereq-subst-local"