From cfd2c229087166ab4cc0a9e2bdb72c8b393bcdd5 Mon Sep 17 00:00:00 2001
From: Julien Lepiller <julien@lepiller.eu>
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