[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/03: packages: 'package-grafts' trims native inputs.
From: |
Ludovic Courtès |
Subject: |
03/03: packages: 'package-grafts' trims native inputs. |
Date: |
Tue, 5 Dec 2017 10:46:08 -0500 (EST) |
civodul pushed a commit to branch version-0.14.0
in repository guix.
commit 91c9b5d016ac8bed127557d378c70fbc56cec0e5
Author: Ludovic Courtès <address@hidden>
Date: Tue Dec 5 16:32:40 2017 +0100
packages: 'package-grafts' trims native inputs.
'package-grafts' returns a list of potentially applicable grafts, which
'cumulative-grafts' then narrows by looking at store item references and
determining the subset of the grafts that's actually applicable.
Until now, 'package-grafts' would traverse native inputs and would thus
return a large superset of the applicable grafts, since native inputs
are not in the reference graph by definition. This patch fixes that by
having 'package-grafts' ignore entirely native inputs from the
dependency graph.
* guix/packages.scm (fold-bag-dependencies)[bag-direct-inputs*]: Add
special case for libc.
* guix/packages.scm (bag-grafts)[native-grafts, target-grafts]: Remove.
[grafts]: New procedure.
Use it.
* tests/packages.scm ("package-grafts, grafts of native inputs
ignored"): New test.
---
guix/packages.scm | 53 +++++++++++++++++++++++++++++++----------------------
tests/packages.scm | 18 ++++++++++++++++++
2 files changed, 49 insertions(+), 22 deletions(-)
diff --git a/guix/packages.scm b/guix/packages.scm
index c6d3b81..490ec86 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 930374d..fe7bd1d 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))))