ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 13:28:12 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

derivations: Coalesce inputs that have the same output path.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2022-03-07 19:03:15 +01:00 committed by Ludovic Courtès
parent 6e09ab9f61
commit 1cad347618
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 54 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
guix/derivations.scm
View file

@ -245,11 +245,19 @@ (define table
(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

50
tests/derivations.scm
View file

@ -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 @@ (define prefix-len (string-length dir))
(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"