diff options
| -rw-r--r-- | guix/packages.scm | 7 | ||||
| -rw-r--r-- | tests/packages.scm | 25 |
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. |