From 2ca41030d5189d83ea2a28ea64cf0e19efed5fd7 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 10 Jun 2019 14:34:36 +0200
Subject: gexp: Add 'lower-gexp' and express 'gexp->derivation' in terms of it.

* guix/gexp.scm (gexp-input-thing, gexp-input-output)
(gexp-input-native?): Export.
(lower-inputs): Return <gexp-input> records instead of tuples.
(lower-reference-graphs): Adjust accordingly.
(<lowered-gexp>): New record type.
(lower-gexp, gexp-input->tuple): New procedure.
(gexp->derivation)[%modules]: Remove.
[requested-graft?]: New variable.
[add-modules]: New procedure.
Rewrite in terms of 'lower-gexp'.
(gexp-inputs): Add TODO comment.
* tests/gexp.scm ("lower-gexp"): New test.
---
 tests/gexp.scm | 37 +++++++++++++++++++++++++++++++++++++
 1 file changed, 37 insertions(+)

(limited to 'tests')

diff --git a/tests/gexp.scm b/tests/gexp.scm
index cee2c96610..23904fce2e 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -832,6 +832,43 @@ (define (multiply x)
       (built-derivations (list drv))
       (return (equal? '(42 84) (call-with-input-file out read))))))
 
+(test-assertm "lower-gexp"
+  (mlet* %store-monad
+      ((extension -> %extension-package)
+       (extension-drv (package->derivation %extension-package))
+       (coreutils-drv (package->derivation coreutils))
+       (exp ->   (with-extensions (list extension)
+                   (with-imported-modules `((guix build utils))
+                     #~(begin
+                         (use-modules (guix build utils)
+                                      (hg2g))
+                         #$coreutils:debug
+                         mkdir-p
+                         the-answer))))
+       (lexp     (lower-gexp exp
+                             #:effective-version "2.0")))
+    (define (matching-input drv output)
+      (lambda (input)
+        (and (eq? (gexp-input-thing input) drv)
+             (string=? (gexp-input-output input) output))))
+
+    (mbegin %store-monad
+      (return (and (find (matching-input extension-drv "out")
+                         (lowered-gexp-inputs (pk 'lexp lexp)))
+                   (find (matching-input coreutils-drv "debug")
+                         (lowered-gexp-inputs lexp))
+                   (member (string-append
+                            (derivation->output-path extension-drv)
+                            "/share/guile/site/2.0")
+                           (lowered-gexp-load-path lexp))
+                   (= 2 (length (lowered-gexp-load-path lexp)))
+                   (member (string-append
+                            (derivation->output-path extension-drv)
+                            "/lib/guile/2.0/site-ccache")
+                           (lowered-gexp-load-compiled-path lexp))
+                   (= 2 (length (lowered-gexp-load-compiled-path lexp)))
+                   (eq? (lowered-gexp-guile lexp) (%guile-for-build)))))))
+
 (test-assertm "gexp->derivation #:references-graphs"
   (mlet* %store-monad
       ((one (text-file "one" (random-text)))
-- 
cgit v1.2.3