03/13: derivations: Coalesce inputs that have the same output path.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 1cad3476189d2ce84fabe95b69db8fb85a10b67a
Author: Ludovic Courtès <ludovic.courtes@inria.fr>
AuthorDate: Mon Mar 7 19:03:15 2022 +0100

    derivations: Coalesce inputs that have the same output path.
    
    Fixes <https://issues.guix.gnu.org/54209>.
    
    * guix/derivations.scm (coalesce-duplicate-inputs): Use the output paths
    of DRV as a hash table key.
    * tests/derivations.scm ("derivation with duplicate fixed-output
    inputs"): Expect a single input for FINAL.
    ("derivation with equivalent fixed-output inputs"): New test.
---
 guix/derivations.scm  | 14 +++++++++++---
 tests/derivations.scm | 50 +++++++++++++++++++++++++++++++++++++++++++-------
 2 files changed, 54 insertions(+), 10 deletions(-)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index f77ea179f4..354ec20e3f 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -245,11 +245,19 @@ Nix itself keeps only one of them."
     (make-hash-table 25))
 
   (for-each (lambda (input)
-              (let* ((drv (derivation-input-path input))
+              ;; If DRV1 and DRV2 are fixed-output derivations with the same
+              ;; output path, they must be coalesced.  Thus, TABLE is keyed by
+              ;; output paths.
+              (let* ((drv (derivation-input-derivation input))
+                     (key (string-join
+                           (map (match-lambda
+                                  ((_ . output)
+                                   (derivation-output-path output)))
+                                (derivation-outputs drv))))
                      (sub-drvs (derivation-input-sub-derivations input)))
-                (match (hash-get-handle table drv)
+                (match (hash-get-handle table key)
                   (#f
-                   (hash-set! table drv input))
+                   (hash-set! table key input))
                   ((and handle (key . ($ <derivation-input> drv sub-drvs2)))
                    ;; Merge DUP with INPUT.
                    (let* ((sub-drvs (delete-duplicates
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 0775719ea3..57d80412dc 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012-2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -436,12 +436,48 @@
                                                 (derivation-input fixed2)))))
     (and (derivation? final)
          (match (derivation-inputs final)
-           (((= derivation-input-derivation one)
-             (= derivation-input-derivation two))
-            (and (not (string=? (derivation-file-name one)
-                                (derivation-file-name two)))
-                 (string=? (derivation->output-path one)
-                           (derivation->output-path two))))))))
+           (((= derivation-input-derivation drv))
+            (memq drv (list fixed1 fixed2)))))))
+
+(test-assert "derivation with equivalent fixed-output inputs"
+  ;; Similar as the test above, but indirectly: DRV3A and DRV3B below are
+  ;; equivalent derivations (same output paths) but they depend on
+  ;; different-but-equivalent fixed-output derivations.  Thus, DRV3A and DRV3B
+  ;; must be coalesced as inputs of DRV4.  See <https://bugs.gnu.org/54209>.
+  (let* ((builder1 (add-text-to-store %store "fixed-builder1.sh"
+                                      "echo -n hello > $out"
+                                      '()))
+         (builder2 (add-text-to-store %store "fixed-builder2.sh"
+                                      "echo -n hello    > $out"
+                                      '()))
+         (builder3 (add-text-to-store %store "user-builder.sh"
+                                      "echo 1 > $one; echo 2 > $two"
+                                      '()))
+         (hash     (gcrypt:sha256 (string->utf8 "hello")))
+         (drv1     (derivation %store "fixed" %bash (list builder1)
+                               #:sources (list builder1)
+                               #:hash hash #:hash-algo 'sha256))
+         (drv2     (derivation %store "fixed" %bash (list builder2)
+                               #:sources (list builder2)
+                               #:hash hash #:hash-algo 'sha256))
+         (drv3a    (derivation %store "fixed-user" %bash (list builder3)
+                               #:outputs '("one" "two")
+                               #:sources (list builder3)
+                               #:inputs (list (derivation-input drv1))))
+         (drv3b    (derivation %store "fixed-user" %bash (list builder3)
+                               #:outputs '("one" "two")
+                               #:sources (list builder3)
+                               #:inputs (list (derivation-input drv2))))
+         (drv4     (derivation %store "fixed-user-user" %bash (list builder1)
+                               #:sources (list builder1)
+                               #:inputs (list (derivation-input drv3a '("one"))
+                                              (derivation-input drv3b 
'("two"))))))
+    (match (derivation-inputs drv4)
+      ((input)
+       (and (memq (derivation-input-derivation input)
+                  (list drv3a drv3b))
+            (lset= string=? (derivation-input-sub-derivations input)
+                   '("one" "two")))))))
 
 (test-assert "multiple-output derivation"
   (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"