summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludovic.courtes@inria.fr>2022-03-07 19:03:15 +0100
committerLudovic Courtès <ludo@gnu.org>2022-03-07 22:49:27 +0100
commit1cad3476189d2ce84fabe95b69db8fb85a10b67a (patch)
tree10909c5e7ce25638456e39615bde339de622760f
parent6e09ab9f614916ad850155407755ef3421a23775 (diff)
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.
-rw-r--r--guix/derivations.scm14
-rw-r--r--tests/derivations.scm50
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"