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

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit fcadd9ff9dfd57c4d386287477e665d4efe9090d
Author: Ludovic Courtès <address@hidden>
Date:   Fri Mar 4 23:01:47 2016 +0100

    packages: The result of 'bag-grafts' does not contain duplicates.
    
    * guix/packages.scm (bag-grafts): Add call to 'delete-duplicates'.
---
 guix/packages.scm  |    7 ++++++-
 tests/packages.scm |   25 +++++++++++++++++++++++++
 2 files changed, 31 insertions(+), 1 deletions(-)

diff --git a/guix/packages.scm b/guix/packages.scm
index 3e50260..1769238 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 4639178..f7af5d4 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.