Revert "packages: 'package-grafts' trims native inputs."
This reverts commit 91c9b5d016
following the concerns raised by Mark, Ben, and Tobias:
<https://lists.gnu.org/archive/html/guix-devel/2017-12/msg00081.html>.
This commit is contained in:
parent
f0eb57b736
commit
609d126e86
|
@ -1004,21 +1004,7 @@ dependencies; otherwise, restrict to target dependencies."
|
||||||
(if (bag-target bag)
|
(if (bag-target bag)
|
||||||
'()
|
'()
|
||||||
(bag-host-inputs bag))))
|
(bag-host-inputs bag))))
|
||||||
(lambda (bag)
|
bag-host-inputs))
|
||||||
(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
|
(define nodes
|
||||||
(match (bag-direct-inputs* bag)
|
(match (bag-direct-inputs* bag)
|
||||||
|
@ -1052,28 +1038,33 @@ to (see 'graft-derivation'.)"
|
||||||
(define system (bag-system bag))
|
(define system (bag-system bag))
|
||||||
(define target (bag-target bag))
|
(define target (bag-target bag))
|
||||||
|
|
||||||
(define (grafts package->graft)
|
(define native-grafts
|
||||||
(fold-bag-dependencies (lambda (package grafts)
|
(let ((->graft (input-graft store system)))
|
||||||
(match (package->graft package)
|
(fold-bag-dependencies (lambda (package grafts)
|
||||||
(#f grafts)
|
(match (->graft package)
|
||||||
(graft (cons graft grafts))))
|
(#f grafts)
|
||||||
'()
|
(graft (cons graft grafts))))
|
||||||
bag
|
'()
|
||||||
|
bag)))
|
||||||
|
|
||||||
;; Grafts that apply to native inputs do not matter
|
(define target-grafts
|
||||||
;; since, by definition, native inputs are not
|
(if target
|
||||||
;; referred to at run time. Thus, ignore
|
(let ((->graft (input-cross-graft store target system)))
|
||||||
;; 'native-inputs' and focus on the others.
|
(fold-bag-dependencies (lambda (package grafts)
|
||||||
#:native? #f))
|
(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
|
;; 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
|
;; that are not 'eq?' but map to the same derivation (this can happen when
|
||||||
;; using things like 'package-with-explicit-inputs'.) Hence the
|
;; using things like 'package-with-explicit-inputs'.) Hence the
|
||||||
;; 'delete-duplicates' call.
|
;; 'delete-duplicates' call.
|
||||||
(delete-duplicates
|
(delete-duplicates
|
||||||
(if target
|
(append native-grafts target-grafts)))
|
||||||
(grafts (input-cross-graft store target system))
|
|
||||||
(grafts (input-graft store system)))))
|
|
||||||
|
|
||||||
(define* (package-grafts store package
|
(define* (package-grafts store package
|
||||||
#:optional (system (%current-system))
|
#:optional (system (%current-system))
|
||||||
|
|
|
@ -660,24 +660,6 @@
|
||||||
;; (package-cross-derivation %store p "mips64el-linux-gnu"
|
;; (package-cross-derivation %store p "mips64el-linux-gnu"
|
||||||
;; #:graft? #t)))
|
;; #: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"
|
(test-assert "package-grafts, indirect grafts"
|
||||||
(let* ((new (dummy-package "dep"
|
(let* ((new (dummy-package "dep"
|
||||||
(arguments '(#:implicit-inputs? #f))))
|
(arguments '(#:implicit-inputs? #f))))
|
||||||
|
|
Loading…
Reference in New Issue