86/155: gexp: Native inputs of nested gexps are properly accounted for.

[John Darrington]

jmd pushed a commit to branch wip-installer
in repository guix.

commit e59ad3c48bc2b0948529487f507f8a9b6b894535
Author: Ludovic Courtès <address@hidden>
Date:   Mon Dec 19 17:06:12 2016 +0100

    gexp: Native inputs of nested gexps are properly accounted for.
    
    Previously, 'gexp-native-inputs' would not return the native inputs of
    nested gexps.  For example, this:
    
      (gexp-native-inputs #~(foo #$#~(bar #+coreutils)))
    
    would return '().
    
    * guix/gexp.scm (gexp-inputs)[add-reference-inputs]: In the
    non-recursive cases, check whether N? and NATIVE? are the same, and act
    accordingly.
    [native-input?]: Remove.
    Fold over all of (gexp-references exp).
    * tests/gexp.scm ("ungexp + ungexp-native, nested, special mixture"):
    New test.
    * tests/gexp.scm ("input list splicing + ungexp-native-splicing"): Pass
     #:native? #t to 'gexp-input'.
---
 guix/gexp.scm  |   28 ++++++++++++----------------
 tests/gexp.scm |   11 ++++++++++-
 2 files changed, 22 insertions(+), 17 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index fd5dc49..5021688 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -678,32 +678,28 @@ references; otherwise, return only non-native references."
        (if (direct-store-path? str)
            (cons `(,str) result)
            result))
-      (($ <gexp-input> (? struct? thing) output)
-       (if (lookup-compiler thing)
+      (($ <gexp-input> (? struct? thing) output n?)
+       (if (and (eqv? n? native?) (lookup-compiler thing))
            ;; THING is a derivation, or a package, or an origin, etc.
            (cons `(,thing ,output) result)
            result))
       (($ <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" (or n? native?))))
-                        lst)))
+       (if (eqv? native? 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" (or n? native?))))
+                            lst))
+           result))
       (_
        ;; Ignore references to other kinds of objects.
        result)))
 
-  (define (native-input? x)
-    (and (gexp-input? x)
-         (gexp-input-native? x)))
-
   (fold-right add-reference-inputs
               '()
-              (if native?
-                  (filter native-input? (gexp-references exp))
-                  (remove native-input? (gexp-references exp)))))
+              (gexp-references exp)))
 
 (define gexp-native-inputs
   (cut gexp-inputs <> #:native? #t))
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 354d28f..797d5fa 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -277,6 +277,14 @@
                           (ungexp %bootstrap-guile)))))
     (list (gexp-inputs exp) '<> (gexp-native-inputs exp))))
 
+(test-equal "ungexp + ungexp-native, nested, special mixture"
+  `(() <> ((,coreutils "out")))
+
+  ;; (gexp-native-inputs exp) used to return '(), wrongfully.
+  (let* ((foo (gexp (foo (ungexp-native coreutils))))
+         (exp (gexp (bar (ungexp foo)))))
+    (list (gexp-inputs exp) '<> (gexp-native-inputs exp))))
+
 (test-assert "input list"
   (let ((exp   (gexp (display
                       '(ungexp (list %bootstrap-guile coreutils)))))
@@ -327,7 +335,8 @@
                  `(list ,@(cons 5 outputs))))))
 
 (test-assert "input list splicing + ungexp-native-splicing"
-  (let* ((inputs (list (gexp-input glibc "debug") %bootstrap-guile))
+  (let* ((inputs (list (gexp-input glibc "debug" #:native? #t)
+                       %bootstrap-guile))
          (exp    (gexp (list (ungexp-native-splicing (cons (+ 2 3) inputs))))))
     (and (lset= equal?
                 `((,glibc "debug") (,%bootstrap-guile "out"))