04/05: gexp: Fix handling of nativeness in nested gexps.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 1123759b4549bedc1a44b5d59a30c886e58ff6bc
Author: Ludovic Courtès <address@hidden>
Date:   Sun Mar 22 23:17:37 2015 +0100

    gexp: Fix handling of nativeness in nested gexps.
    
    * guix/gexp.scm (gexp-inputs): Remove 'references' parameter; add
      #:native? and honor it.
      [add-reference-inputs]: Distinguish between native gexp inputs, and
      non-native gexp inputs.  Honor 'native?' field of list inputs.
    * tests/gexp.scm ("ungexp + ungexp-native, nested"): New test.
---
 guix/gexp.scm  |   30 +++++++++++++++++++++---------
 tests/gexp.scm |    6 ++++++
 2 files changed, 27 insertions(+), 9 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 3081ab0..01290db 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -353,13 +353,23 @@ The other arguments are as for 'derivation'."
                       #:allowed-references allowed
                       #:local-build? local-build?))))
 
-(define* (gexp-inputs exp #:optional (references gexp-references))
-  "Return the input list for EXP, using REFERENCES to get its list of
-references."
+(define* (gexp-inputs exp #:key native?)
+  "Return the input list for EXP.  When NATIVE? is true, return only native
+references; otherwise, return only non-native references."
   (define (add-reference-inputs ref result)
     (match ref
-      (($ <gexp-input> (? gexp? exp))
-       (append (gexp-inputs exp references) result))
+      (($ <gexp-input> (? gexp? exp) _ #t)
+       (if native?
+           (append (gexp-inputs exp)
+                   (gexp-inputs exp #:native? #t)
+                   result)
+           result))
+      (($ <gexp-input> (? gexp? exp) _ #f)
+       (if native?
+           (append (gexp-inputs exp #:native? #t)
+                   result)
+           (append (gexp-inputs exp)
+                   result)))
       (($ <gexp-input> (? string? str))
        (if (direct-store-path? str)
            (cons `(,str) result)
@@ -369,13 +379,13 @@ references."
            ;; THING is a derivation, or a package, or an origin, etc.
            (cons `(,thing ,output) result)
            result))
-      (($ <gexp-input> (lst ...) output native?)
+      (($ <gexp-input> (lst ...) output n?)
        (fold-right add-reference-inputs result
                    ;; XXX: For now, automatically convert LST to a list of
                    ;; gexp-inputs.
                    (map (match-lambda
                          ((? gexp-input? x) x)
-                         (x (%gexp-input x "out" native?)))
+                         (x (%gexp-input x "out" (or n? native?))))
                         lst)))
       (_
        ;; Ignore references to other kinds of objects.
@@ -383,10 +393,12 @@ references."
 
   (fold-right add-reference-inputs
               '()
-              (references exp)))
+              (if native?
+                  (gexp-native-references exp)
+                  (gexp-references exp))))
 
 (define gexp-native-inputs
-  (cut gexp-inputs <> gexp-native-references))
+  (cut gexp-inputs <> #:native? #t))
 
 (define (gexp-outputs exp)
   "Return the outputs referred to by EXP as a list of strings."
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 27c0846..0540969 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -160,6 +160,12 @@
          (equal? `(list ,guile ,cu ,libc ,bu)
                  (gexp->sexp* exp target)))))
 
+(test-equal "ungexp + ungexp-native, nested"
+  (list `((,%bootstrap-guile "out")) '<> `((,coreutils "out")))
+  (let* ((exp (gexp (list (ungexp-native (gexp (ungexp coreutils)))
+                          (ungexp %bootstrap-guile)))))
+    (list (gexp-inputs exp) '<> (gexp-native-inputs exp))))
+
 (test-assert "input list"
   (let ((exp   (gexp (display
                       '(ungexp (list %bootstrap-guile coreutils)))))