From 5b14a7902c58d9fb7923f9e16871f549fbe59b6e Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 19 Dec 2016 17:06:12 +0100
Subject: 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'.
---
 tests/gexp.scm | 11 ++++++++++-
 1 file changed, 10 insertions(+), 1 deletion(-)

(limited to 'tests/gexp.scm')

diff --git a/tests/gexp.scm b/tests/gexp.scm
index 354d28f014..797d5fa457 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"))
-- 
cgit v1.2.3


From 5e2e4a51f93f98c35824e4a7f5a88274d1551b4c Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 1 Jan 2017 22:22:14 +0100
Subject: gexp: Support 'ungexp' forms in improper lists.

* guix/gexp.scm (gexp)[collect-escapes, substitute-references]: Replace
the (exp0 exp ...) patterns with (exp0 . exp) to match improper lists.
Adjust clause bodies accordingly.
* tests/gexp.scm ("one input package, dotted list"): New test.
---
 guix/gexp.scm  |  8 ++++----
 tests/gexp.scm | 12 +++++++++++-
 2 files changed, 15 insertions(+), 5 deletions(-)

(limited to 'tests/gexp.scm')

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 79a7b18b09..1f7fbef0a0 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -812,9 +812,9 @@ environment."
            (cons exp result))
           ((ungexp-native-splicing _ ...)
            (cons exp result))
-          ((exp0 exp ...)
+          ((exp0 . exp)
            (let ((result (loop #'exp0 result)))
-             (fold loop result #'(exp ...))))
+             (loop  #'exp result)))
           (_
            result))))
 
@@ -875,9 +875,9 @@ environment."
          (substitute-ungexp-splicing exp substs))
         (((ungexp-native-splicing _ ...) rest ...)
          (substitute-ungexp-splicing exp substs))
-        ((exp0 exp ...)
+        ((exp0 . exp)
          #`(cons #,(substitute-references #'exp0 substs)
-                 #,(substitute-references #'(exp ...) substs)))
+                 #,(substitute-references #'exp substs)))
         (x #''x)))
 
     (syntax-case s (ungexp output)
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 797d5fa457..baf78837ae 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -92,6 +92,16 @@
                              (package-derivation %store coreutils)))
                  (gexp->sexp* exp)))))
 
+(test-assert "one input package, dotted list"
+  (let ((exp (gexp (coreutils . (ungexp coreutils)))))
+    (and (gexp? exp)
+         (match (gexp-inputs exp)
+           (((p "out"))
+            (eq? p coreutils)))
+         (equal? `(coreutils . ,(derivation->output-path
+                                 (package-derivation %store coreutils)))
+                 (gexp->sexp* exp)))))
+
 (test-assert "one input origin"
   (let ((exp (gexp (display (ungexp (package-source coreutils))))))
     (and (gexp? exp)
-- 
cgit v1.2.3