kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

packages: Delete duplicate inputs when lowering bags.

Browse Source 
This is a followup to 18fa433bf5c420868562b9f4b017c5c97251a44b and
<https://issues.guix.gnu.org/43508>.

* guix/packages.scm (derivation=?, input=?): New procedures.
(bag->derivation, bag->cross-derivation): Add calls to
'delete-duplicates'.
* tests/packages.scm ("package-derivation, inputs deduplicated"): New
test.
This commit is contained in:
Ludovic Courtès 2020-10-15 23:01:57 +02:00
parent 370adc91b5
commit 6b4663363c
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 37 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
guix/packages.scm
View File

@ -1322,6 +1322,22 @@ TARGET."
(bag (package->bag package system target)))
(bag-grafts store bag)))
(define-inlinable (derivation=? drv1 drv2)
"Return true if DRV1 and DRV2 are equal."
(or (eq? drv1 drv2)
(string=? (derivation-file-name drv1)
(derivation-file-name drv2))))
(define (input=? input1 input2)
"Return true if INPUT1 and INPUT2 are equivalent."
(match input1
((label1 drv1 . outputs1)
(match input2
((label2 drv2 . outputs2)
(and (string=? label1 label2)
(equal? outputs1 outputs2)
(derivation=? drv1 drv2)))))))
(define* (bag->derivation store bag
#:optional context)
"Return the derivation to build BAG for SYSTEM. Optionally, CONTEXT can be
@ -1340,9 +1356,12 @@ error reporting."
p))
(_ '()))
inputs))))
;; It's possible that INPUTS contains packages that are not 'eq?' but
;; that lead to the same derivation. Delete those duplicates to avoid
;; issues down the road, such as duplicate entries in '%build-inputs'.
(apply (bag-build bag)
store (bag-name bag) input-drvs
store (bag-name bag)
(delete-duplicates input-drvs input=?)
#:search-paths paths
#:outputs (bag-outputs bag) #:system system
(bag-arguments bag)))))
@ -1380,8 +1399,9 @@ This is an internal procedure."
(apply (bag-build bag)
store (bag-name bag)
#:native-drvs build-drvs
#:target-drvs (append host-drvs target-drvs)
#:native-drvs (delete-duplicates build-drvs input=?)
#:target-drvs (delete-duplicates (append host-drvs target-drvs)
input=?)
#:search-paths paths
#:native-search-paths npaths
#:outputs (bag-outputs bag)

13
tests/packages.scm
View File

@ -611,6 +611,19 @@
(and (derivation? drv)
(file-exists? (derivation-file-name drv)))))
(test-assert "package-derivation, inputs deduplicated"
(let* ((dep (dummy-package "dep"))
(p0 (dummy-package "p" (inputs `(("dep" ,dep)))))
(p1 (package (inherit p0)
(inputs `(("dep" ,(package (inherit dep)))
,@(package-inputs p0))))))
;; Here P1 ends up with two non-eq? copies of DEP, under the same label.
;; They should be deduplicated so that P0 and P1 lead to the same
;; derivation rather than P1 ending up with duplicate entries in its
;; '%build-inputs' variable.
(string=? (derivation-file-name (package-derivation %store p0))
(derivation-file-name (package-derivation %store p1)))))
(test-assert "package-output"
(let* ((package (dummy-package "p"))
(drv (package-derivation %store package)))