diff options
| -rw-r--r-- | guix/packages.scm | 53 | ||||
| -rw-r--r-- | tests/packages.scm | 18 |
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)))) |