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

packages: The result of 'bag-grafts' does not contain duplicates.

Browse Source 
* guix/packages.scm (bag-grafts): Add call to 'delete-duplicates'.
This commit is contained in:
Ludovic Courtès 2016-03-04 23:01:47 +01:00
parent c90cb5c9d8
commit fcadd9ff9d
2 changed files with 31 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
guix/packages.scm
View File

@ -927,7 +927,12 @@ to (see 'graft-derivation'.)"
#:native? #f))
'()))
(append native-grafts target-grafts))
;; We can end up with several identical grafts if we stumble upon packages
;; that are not 'eq?' but map to the same derivation (this can happen when
;; using things like 'package-with-explicit-inputs'.) Hence the
;; 'delete-duplicates' call.
(delete-duplicates
(append native-grafts target-grafts)))
(define* (package-grafts store package
#:optional (system (%current-system))

25
tests/packages.scm
View File

@ -20,6 +20,7 @@
#:use-module (guix tests)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix grafts)
#:use-module ((guix utils)
;; Rename the 'location' binding to allow proper syntax
;; matching when setting the 'location' field of a package.
@ -605,6 +606,30 @@
(origin (package-derivation %store dep))
(replacement (package-derivation %store new)))))))
(test-assert "package-grafts, same replacement twice"
(let* ((new (dummy-package "dep"
(version "1")
(arguments '(#:implicit-inputs? #f))))
(dep (package (inherit new) (version "0") (replacement new)))
(p1 (dummy-package "intermediate1"
(arguments '(#:implicit-inputs? #f))
(inputs `(("dep" ,dep)))))
(p2 (dummy-package "intermediate2"
(arguments '(#:implicit-inputs? #f))
;; Here we copy DEP to have an equivalent package that is not
;; 'eq?' to DEP. This is similar to what happens with
;; 'package-with-explicit-inputs' & co.
(inputs `(("dep" ,(package (inherit dep)))))))
(p3 (dummy-package "final"
(arguments '(#:implicit-inputs? #f))
(inputs `(("p1" ,p1) ("p2" ,p2))))))
(equal? (package-grafts %store p3)
(list (graft
(origin (package-derivation %store
(package (inherit dep)
(replacement #f))))
(replacement (package-derivation %store new)))))))
;;; XXX: Nowadays 'graft-derivation' needs to build derivations beforehand to
;;; find out about their run-time dependencies, so this test is no longer
;;; applicable since it would trigger a full rebuild.