summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-12-06 09:07:28 +0100
committerLudovic Courtès <ludo@gnu.org>2017-12-06 09:07:28 +0100
commit609d126e86ea7a05ab7e758fa3fd000ced005f49 (patch)
tree9bc27e832508ae30cb75016d2d1ad789ce988c15
parentf0eb57b736f6fae67acbaad66a1b5e18fdfc10a0 (diff)
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>.
-rw-r--r--guix/packages.scm53
-rw-r--r--tests/packages.scm18
2 files changed, 22 insertions, 49 deletions
diff --git a/guix/packages.scm b/guix/packages.scm
index 490ec86906..c6d3b811f2 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 fe7bd1ded6..930374dabf 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))))