~ruther/guix-local

609d126e86ea7a05ab7e758fa3fd000ced005f49 — Ludovic Courtès 8 years ago f0eb57b
Revert "packages: 'package-grafts' trims native inputs."

This reverts commit 91c9b5d016ac8bed127557d378c70fbc56cec0e5
following the concerns raised by Mark, Ben, and Tobias:
<https://lists.gnu.org/archive/html/guix-devel/2017-12/msg00081.html>.
2 files changed, 22 insertions(+), 49 deletions(-)

M guix/packages.scm
M tests/packages.scm
M guix/packages.scm => guix/packages.scm +22 -31
@@ 1004,21 1004,7 @@ dependencies; otherwise, restrict to target dependencies."
                  (if (bag-target bag)
                      '()
                      (bag-host-inputs bag))))
        (lambda (bag)
          (if (bag-target bag)
              (bag-host-inputs bag)

              ;; XXX: Currently libc wrongfully ends up in 'build-inputs',
              ;; even tough it's something that's still referenced at run time
              ;; and thus conceptually a 'host-inputs'.  Because of that, we
              ;; re-add it here.
              (if (assoc-ref (bag-host-inputs bag) "libc")
                  (bag-host-inputs bag)
                  (append (let ((libc (assoc-ref (bag-build-inputs bag)
                                                 "libc")))
                            (or (and libc `(("libc" ,@libc)))
                                '()))
                          (bag-host-inputs bag)))))))
        bag-host-inputs))

  (define nodes
    (match (bag-direct-inputs* bag)


@@ 1052,28 1038,33 @@ to (see 'graft-derivation'.)"
  (define system (bag-system bag))
  (define target (bag-target bag))

  (define (grafts package->graft)
    (fold-bag-dependencies (lambda (package grafts)
                             (match (package->graft package)
                               (#f    grafts)
                               (graft (cons graft grafts))))
                           '()
                           bag

                           ;; Grafts that apply to native inputs do not matter
                           ;; since, by definition, native inputs are not
                           ;; referred to at run time.  Thus, ignore
                           ;; 'native-inputs' and focus on the others.
                           #:native? #f))
  (define native-grafts
    (let ((->graft (input-graft store system)))
      (fold-bag-dependencies (lambda (package grafts)
                               (match (->graft package)
                                 (#f    grafts)
                                 (graft (cons graft grafts))))
                             '()
                             bag)))

  (define target-grafts
    (if target
        (let ((->graft (input-cross-graft store target system)))
          (fold-bag-dependencies (lambda (package grafts)
                                   (match (->graft package)
                                     (#f    grafts)
                                     (graft (cons graft grafts))))
                                 '()
                                 bag
                                 #:native? #f))
        '()))

  ;; 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
   (if target
       (grafts (input-cross-graft store target system))
       (grafts (input-graft store system)))))
   (append native-grafts target-grafts)))

(define* (package-grafts store package
                         #:optional (system (%current-system))

M tests/packages.scm => tests/packages.scm +0 -18
@@ 660,24 660,6 @@
;;     (package-cross-derivation %store p "mips64el-linux-gnu"
;;                               #:graft? #t)))

;; It doesn't make sense for 'package-grafts' to look at native inputs since,
;; by definition, they are not referenced at run time.  Make sure
;; 'package-grafts' respects this.
(test-equal "package-grafts, grafts of native inputs ignored"
  '()
  (let* ((new   (dummy-package "native-dep"
                  (version "0.1")
                  (arguments '(#:implicit-inputs? #f))))
         (ndep  (package (inherit new) (version "0.0")
                         (replacement new)))
         (dep   (dummy-package "dep"
                  (arguments '(#:implicit-inputs? #f))))
         (dummy (dummy-package "dummy"
                  (arguments '(#:implicit-inputs? #f))
                  (native-inputs `(("ndep" ,ndep)))
                  (inputs `(("dep" ,dep))))))
    (package-grafts %store dummy)))

(test-assert "package-grafts, indirect grafts"
  (let* ((new   (dummy-package "dep"
                  (arguments '(#:implicit-inputs? #f))))