Hi, I've been looking at our current code and would like to propose the
attached patch for that issue.
>From cfd2c229087166ab4cc0a9e2bdb72c8b393bcdd5 Mon Sep 17 00:00:00 2001
From: Julien Lepiller <[email protected]>
Date: Thu, 1 Aug 2019 22:09:38 +0200
Subject: [PATCH] guix: Recursively honor search paths of dependencies.
* guix/packages.scm (all-transitive-inputs)
(package-all-transitive-inputs)
(package-all-transitive-native-search-paths): New procedures.
* guix/profiles.scm (package->manifest-entry): Use
package-all-transitive-native-search-paths to generate manifest search
paths.
---
guix/packages.scm | 53 +++++++++++++++++++++++++++++++++++++++++++++++
guix/profiles.scm | 2 +-
2 files changed, 54 insertions(+), 1 deletion(-)
diff --git a/guix/packages.scm b/guix/packages.scm
index c94a651f27..f9095759f1 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -101,6 +101,7 @@
package-transitive-propagated-inputs
package-transitive-native-search-paths
package-transitive-supported-systems
+ package-all-transitive-native-search-paths
package-mapping
package-input-rewriting
package-input-rewriting/spec
@@ -686,6 +687,42 @@ preserved, and only duplicate propagated inputs are removed."
((input rest ...)
(loop rest (cons input result) propagated first? seen)))))
+(define (all-transitive-inputs inputs)
+ "Return the closure of INPUTS when considering the 'propagated-inputs',
+'inputs' and 'native-inputs' edges. Omit duplicate inputs, except for
+those already present in INPUTS itself.
+
+This is implemented as a breadth-first traversal such that INPUTS is
+preserved, and only duplicate propagated inputs are removed."
+ (define (seen? seen item outputs)
+ ;; FIXME: We're using pointer identity here, which is extremely sensitive
+ ;; to memoization in package-producing procedures; see
+ ;; <https://bugs.gnu.org/30155>.
+ (match (vhash-assq item seen)
+ ((_ . o) (equal? o outputs))
+ (_ #f)))
+
+ (let loop ((inputs inputs)
+ (result '())
+ (transitive '())
+ (first? #t)
+ (seen vlist-null))
+ (match inputs
+ (()
+ (if (null? transitive)
+ (reverse result)
+ (loop (reverse (concatenate transitive)) result '() #f seen)))
+ (((and input (label (? package? package) outputs ...)) rest ...)
+ (if (and (not first?) (seen? seen package outputs))
+ (loop rest result transitive first? seen)
+ (loop rest
+ (cons input result)
+ (cons (package-direct-inputs package) transitive)
+ first?
+ (vhash-consq package outputs seen))))
+ ((input rest ...)
+ (loop rest (cons input result) transitive first? seen)))))
+
(define (package-direct-sources package)
"Return all source origins associated with PACKAGE; including origins in
PACKAGE's inputs."
@@ -720,6 +757,11 @@ with their propagated inputs."
with their propagated inputs, recursively."
(transitive-inputs (package-direct-inputs package)))
+(define (package-all-transitive-inputs package)
+ "Return the transitive inputs of PACKAGE---i.e., its direct inputs along
+with their propagated inputs, recursively."
+ (all-transitive-inputs (package-direct-inputs package)))
+
(define (package-transitive-target-inputs package)
"Return the transitive target inputs of PACKAGE---i.e., its direct inputs
along with their propagated inputs, recursively. This only includes inputs
@@ -749,6 +791,17 @@ recursively."
'()))
(package-transitive-propagated-inputs package))))
+(define (package-all-transitive-native-search-paths package)
+ "Return the list of search paths for PACKAGE and its propagated inputs,
+recursively."
+ (append (package-native-search-paths package)
+ (append-map (match-lambda
+ ((label (? package? p) _ ...)
+ (package-native-search-paths p))
+ (_
+ '()))
+ (package-all-transitive-inputs package))))
+
(define (transitive-input-references alist inputs)
"Return a list of (assoc-ref ALIST <label>) for each (<label> <package> . _)
in INPUTS and their transitive propagated inputs."
diff --git a/guix/profiles.scm b/guix/profiles.scm
index f5c863945c..dd6a31562f 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -318,7 +318,7 @@ file name."
(item package)
(dependencies (delete-duplicates deps))
(search-paths
- (package-transitive-native-search-paths package))
+ (package-all-transitive-native-search-paths package))
(parent parent)
(properties properties))))
entry))
--
2.22.0
