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

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 @@ (define target-grafts
#:native? #f)) #: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 (define* (package-grafts store package
#:optional (system (%current-system)) #:optional (system (%current-system))

25
tests/packages.scm
View file

@ -20,6 +20,7 @@ (define-module (test-packages)
#:use-module (guix tests) #:use-module (guix tests)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix grafts)
#:use-module ((guix utils) #:use-module ((guix utils)
;; Rename the 'location' binding to allow proper syntax ;; Rename the 'location' binding to allow proper syntax
;; matching when setting the 'location' field of a package. ;; matching when setting the 'location' field of a package.
@ -605,6 +606,30 @@ (define read-at
(origin (package-derivation %store dep)) (origin (package-derivation %store dep))
(replacement (package-derivation %store new))))))) (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 ;;; XXX: Nowadays 'graft-derivation' needs to build derivations beforehand to
;;; find out about their run-time dependencies, so this test is no longer ;;; find out about their run-time dependencies, so this test is no longer
;;; applicable since it would trigger a full rebuild. ;;; applicable since it would trigger a full rebuild.