01/04: packages: Add 'package-transitive-native-search-paths'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit aa8e051532a144ce86c13169e08abdd554b9823e
Author: Ludovic Courtès <address@hidden>
Date:   Sun Dec 20 14:34:36 2015 +0100

    packages: Add 'package-transitive-native-search-paths'.
    
    * guix/packages.scm (package-transitive-native-search-paths): New
    procedure.
    * tests/packages.scm ("package-transitive-native-search-paths"): New
    test.
---
 guix/packages.scm  |   12 ++++++++++++
 tests/packages.scm |   21 +++++++++++++++++++++
 2 files changed, 33 insertions(+), 0 deletions(-)

diff --git a/guix/packages.scm b/guix/packages.scm
index 68fb091..41f3e20 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -89,6 +89,7 @@
             package-transitive-target-inputs
             package-transitive-native-inputs
             package-transitive-propagated-inputs
+            package-transitive-native-search-paths
             package-transitive-supported-systems
             package-source-derivation
             package-derivation
@@ -632,6 +633,17 @@ for the host system (\"native inputs\"), and not target 
inputs."
 recursively."
   (transitive-inputs (package-propagated-inputs package)))
 
+(define (package-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-transitive-propagated-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/tests/packages.scm b/tests/packages.scm
index b28ae0b..6a2f4f0 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -29,6 +29,7 @@
   #:use-module (guix hash)
   #:use-module (guix derivations)
   #:use-module (guix packages)
+  #:use-module (guix search-paths)
   #:use-module (guix build-system)
   #:use-module (guix build-system trivial)
   #:use-module (guix build-system gnu)
@@ -504,6 +505,26 @@
            (equal? x (collect (package-derivation %store b)))
            (equal? x (collect (package-derivation %store c)))))))
 
+(test-assert "package-transitive-native-search-paths"
+  (let* ((sp (lambda (name)
+               (list (search-path-specification
+                      (variable name)
+                      (files '("foo/bar"))))))
+         (p0 (dummy-package "p0" (native-search-paths (sp "PATH0"))))
+         (p1 (dummy-package "p1" (native-search-paths (sp "PATH1"))))
+         (p2 (dummy-package "p2"
+               (native-search-paths (sp "PATH2"))
+               (inputs `(("p0" ,p0)))
+               (propagated-inputs `(("p1" ,p1)))))
+         (p3 (dummy-package "p3"
+               (native-search-paths (sp "PATH3"))
+               (native-inputs `(("p0" ,p0)))
+               (propagated-inputs `(("p2" ,p2))))))
+    (lset= string=?
+           '("PATH1" "PATH2" "PATH3")
+           (map search-path-specification-variable
+                (package-transitive-native-search-paths p3)))))
+
 (test-assert "package-cross-derivation"
   (let ((drv (package-cross-derivation %store (dummy-package "p")
                                        "mips64el-linux-gnu")))