derivations: build-expression->derivation: Builder only refers to sources.

* guix/derivations.scm (build-expression->derivation)[source-path]: New
  procedure.
  [builder]: Pass only sources as references.  This fixes a bug whereby
  changing a fixed-output drv referred to by a builder would cause the
  builder's hash to change, thereby leading to a full rebuild.
* tests/derivations.scm ("build-expression->derivation with a
  fixed-output input"): New test.

2 files changed, 54 insertions, 1 deletions

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 7fc8734238..cbf755ab63 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -595,6 +595,14 @@ omitted or is #f, the value of the `%guile-for-build' fluid is used instead."
       (((or 'define-module 'use-modules) _ ...) #t)
       (_ #f)))
 
+  (define source-path
+    ;; When passed an input that is a source, return its path; otherwise
+    ;; return #f.
+    (match-lambda
+     ((_ path _ ...)
+      (and (not (derivation-path? path))
+           path))))
+
   (let* ((prologue `(begin
                       ,@(match exp
                           ((_ ...)
@@ -639,7 +647,18 @@ omitted or is #f, the value of the `%guile-for-build' fluid is used instead."
                                              ((_ ...)
                                               (remove module-form? exp))
                                              (_ `(,exp))))))
-                                      (map second inputs)))
+
+                                      ;; The references don't really matter
+                                      ;; since the builder is always used in
+                                      ;; conjunction with the drv that needs
+                                      ;; it.  For clarity, we add references
+                                      ;; to the subset of INPUTS that are
+                                      ;; sources, avoiding references to other
+                                      ;; .drv; otherwise, BUILDER's hash would
+                                      ;; depend on those, even if they are
+                                      ;; fixed-output.
+                                      (filter-map source-path inputs)))
+
          (mod-drv  (and (pair? modules)
                         (imported-modules store modules
                                           #:guile guile-drv
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 7fde2ef2a2..01ede11af0 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -459,6 +459,40 @@
          (string=? (derivation-path->output-path input1)
                    (derivation-path->output-path input2)))))
 
+(test-assert "build-expression->derivation with a fixed-output input"
+  (let* ((builder1   '(call-with-output-file %output
+                        (lambda (p)
+                          (write "hello" p))))
+         (builder2   '(call-with-output-file (pk 'difference-here! %output)
+                        (lambda (p)
+                          (write "hello" p))))
+         (hash       (sha256 (string->utf8 "hello")))
+         (input1     (build-expression->derivation %store "fixed"
+                                                   (%current-system)
+                                                   builder1 '()
+                                                   #:hash hash
+                                                   #:hash-algo 'sha256))
+         (input2     (build-expression->derivation %store "fixed"
+                                                   (%current-system)
+                                                   builder2 '()
+                                                   #:hash hash
+                                                   #:hash-algo 'sha256))
+         (builder3  '(let ((input (assoc-ref %build-inputs "input")))
+                       (call-with-output-file %output
+                         (lambda (out)
+                           (format #f "My input is ~a.~%" input)))))
+         (final1    (build-expression->derivation %store "final"
+                                                  (%current-system)
+                                                  builder3
+                                                  `(("input" ,input1))))
+         (final2    (build-expression->derivation %store "final"
+                                                  (%current-system)
+                                                  builder3
+                                                  `(("input" ,input2)))))
+    (and (string=? (derivation-path->output-path final1)
+                   (derivation-path->output-path final2))
+         (build-derivations %store (list final1 final2)))))
+
 (test-end)