diff options
| -rw-r--r-- | guix/packages.scm | 53 | ||||
| -rw-r--r-- | tests/packages.scm | 18 |
2 files changed, 49 insertions, 22 deletions
diff --git a/guix/packages.scm b/guix/packages.scm index c6d3b811f2..490ec86906 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -1004,7 +1004,21 @@ dependencies; otherwise, restrict to target dependencies." (if (bag-target bag) '() (bag-host-inputs bag)))) - bag-host-inputs)) + (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))))))) (define nodes (match (bag-direct-inputs* bag) @@ -1038,33 +1052,28 @@ to (see 'graft-derivation'.)" (define system (bag-system bag)) (define target (bag-target bag)) - (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)) - '())) + (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)) ;; 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))) + (if target + (grafts (input-cross-graft store target system)) + (grafts (input-graft store system))))) (define* (package-grafts store package #:optional (system (%current-system)) diff --git a/tests/packages.scm b/tests/packages.scm index 930374dabf..fe7bd1ded6 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -660,6 +660,24 @@ ;; (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)))) |