aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/packages.scm7
-rw-r--r--tests/packages.scm25
2 files changed, 31 insertions, 1 deletions
diff --git a/guix/packages.scm b/guix/packages.scm
index 3e50260069..1769238b5e 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -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))
diff --git a/tests/packages.scm b/tests/packages.scm
index 46391783b0..f7af5d4bb5 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -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.