~ruther/guix-local

fcadd9ff9dfd57c4d386287477e665d4efe9090d — Ludovic Courtès 10 years ago c90cb5c
packages: The result of 'bag-grafts' does not contain duplicates.

* guix/packages.scm (bag-grafts): Add call to 'delete-duplicates'.
2 files changed, 31 insertions(+), 1 deletions(-)

M guix/packages.scm
M tests/packages.scm
M guix/packages.scm => guix/packages.scm +6 -1
@@ 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))

M tests/packages.scm => tests/packages.scm +25 -0
@@ 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.