From a9e5e92f940381e3a4ee828c6d8ff22a73067e17 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 9 Sep 2016 22:46:36 +0200
Subject: gexp: Add 'file-append'.

* guix/gexp.scm (<file-append>): New record type.
(file-append): New procedure.
(file-append-compiler): New gexp compiler.
* tests/gexp.scm ("file-append", "file-append, output")
("file-append, nested", "gexp->file + file-append"): New tests.
* doc/guix.texi (G-Expressions): Use it in 'nscd' and 'list-files'
examples.  Document 'file-append'.
---
 tests/gexp.scm | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 53 insertions(+)

(limited to 'tests/gexp.scm')

diff --git a/tests/gexp.scm b/tests/gexp.scm
index 03a64fa6bb..214e7a5302 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -207,6 +207,47 @@
                (e3 `(display ,txt)))
            (equal? `(begin ,e0 ,e1 ,e2 ,e3) (gexp->sexp* exp))))))
 
+(test-assert "file-append"
+  (let* ((drv (package-derivation %store %bootstrap-guile))
+         (fa  (file-append %bootstrap-guile "/bin/guile"))
+         (exp #~(here we go #$fa)))
+    (and (match (gexp->sexp* exp)
+           (('here 'we 'go (? string? result))
+            (string=? result
+                      (string-append (derivation->output-path drv)
+                                     "/bin/guile"))))
+         (match (gexp-inputs exp)
+           (((thing "out"))
+            (eq? thing fa))))))
+
+(test-assert "file-append, output"
+  (let* ((drv (package-derivation %store glibc))
+         (fa  (file-append glibc "/lib" "/debug"))
+         (exp #~(foo #$fa:debug)))
+    (and (match (gexp->sexp* exp)
+           (('foo (? string? result))
+            (string=? result
+                      (string-append (derivation->output-path drv "debug")
+                                     "/lib/debug"))))
+         (match (gexp-inputs exp)
+           (((thing "debug"))
+            (eq? thing fa))))))
+
+(test-assert "file-append, nested"
+  (let* ((drv   (package-derivation %store glibc))
+         (dir   (file-append glibc "/bin"))
+         (slash (file-append dir "/"))
+         (file  (file-append slash "getent"))
+         (exp   #~(foo #$file)))
+    (and (match (gexp->sexp* exp)
+           (('foo (? string? result))
+            (string=? result
+                      (string-append (derivation->output-path drv)
+                                     "/bin/getent"))))
+         (match (gexp-inputs exp)
+           (((thing "out"))
+            (eq? thing file))))))
+
 (test-assert "ungexp + ungexp-native"
   (let* ((exp    (gexp (list (ungexp-native %bootstrap-guile)
                              (ungexp coreutils)
@@ -338,6 +379,18 @@
     (return (and (equal? sexp (call-with-input-file out read))
                  (equal? (list guile) refs)))))
 
+(test-assertm "gexp->file + file-append"
+  (mlet* %store-monad ((exp -> #~#$(file-append %bootstrap-guile
+                                                "/bin/guile"))
+                       (guile  (package-file %bootstrap-guile))
+                       (drv    (gexp->file "foo" exp))
+                       (out -> (derivation->output-path drv))
+                       (done   (built-derivations (list drv)))
+                       (refs   ((store-lift references) out)))
+    (return (and (equal? (string-append guile "/bin/guile")
+                         (call-with-input-file out read))
+                 (equal? (list guile) refs)))))
+
 (test-assertm "gexp->derivation"
   (mlet* %store-monad ((file    (text-file "foo" "Hello, world!"))
                        (exp ->  (gexp
-- 
cgit v1.2.3