04/07: Revert "packages: 'package-grafts' trims native inputs."

[Ludovic Courtès]

civodul pushed a commit to branch version-0.14.0
in repository guix.

commit 609d126e86ea7a05ab7e758fa3fd000ced005f49
Author: Ludovic Courtès <address@hidden>
Date:   Wed Dec 6 09:07:28 2017 +0100

    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>.
---
 guix/packages.scm  | 53 ++++++++++++++++++++++-------------------------------
 tests/packages.scm | 18 ------------------
 2 files changed, 22 insertions(+), 49 deletions(-)

diff --git a/guix/packages.scm b/guix/packages.scm
index 490ec86..c6d3b81 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -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))
diff --git a/tests/packages.scm b/tests/packages.scm
index fe7bd1d..930374d 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -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))))