gnu: Add rewritefs.

[jackhill/guix/guix.git] / tests / gexp.scm

diff --git a/tests/gexp.scm b/tests/gexp.scm
index 0bd1237..39a47d4 100644 (file)
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -57,8 +58,7 @@
   (apply (@@ (guix gexp) gexp->sexp) x))
 
 (define* (gexp->sexp* exp #:optional target)
-  (run-with-store %store (gexp->sexp exp
-                                     #:target target)
+  (run-with-store %store (gexp->sexp exp (%current-system) target)
                   #:guile-for-build (%guile-for-build)))
 
 (define (gexp-input->tuple input)
@@ -90,6 +90,36 @@
 \f
 (test-begin "gexp")
 
+(test-equal "no references"
+  '(display "hello gexp->approximate-sexp!")
+  (gexp->approximate-sexp #~(display "hello gexp->approximate-sexp!")))
+
+(test-equal "unquoted gexp"
+  '(display "hello")
+  (let ((inside #~"hello"))
+    (gexp->approximate-sexp #~(display #$inside))))
+
+(test-equal "unquoted gexp (native)"
+  '(display "hello")
+  (let ((inside #~"hello"))
+    (gexp->approximate-sexp #~(display #+inside))))
+
+(test-equal "spliced gexp"
+  '(display '(fresh vegetables))
+  (let ((inside #~(fresh vegetables)))
+    (gexp->approximate-sexp #~(display '(#$@inside)))))
+
+(test-equal "unspliced gexp, approximated"
+  ;; (*approximate*) is really an implementation detail
+  '(display '(*approximate*))
+  (let ((inside (file-append coreutils "/bin/hello")))
+    (gexp->approximate-sexp #~(display '(#$@inside)))))
+
+(test-equal "unquoted gexp, approximated"
+  '(display '(*approximate*))
+  (let ((inside (file-append coreutils "/bin/hello")))
+    (gexp->approximate-sexp #~(display '#$inside))))
+
 (test-equal "no refs"
   '(display "hello!")
   (let ((exp (gexp (display "hello!"))))
@@ -540,7 +570,7 @@
 (test-assertm "gexp->file"
   (mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile))))
                        (guile  (package-file %bootstrap-guile))
-                       (sexp   (gexp->sexp exp))
+                       (sexp   (gexp->sexp exp (%current-system) #f))
                        (drv    (gexp->file "foo" exp))
                        (out -> (derivation->output-path drv))
                        (done   (built-derivations (list drv)))
@@ -1096,6 +1126,22 @@ importing.* \\(guix config\\) from the host"
                         (call-with-input-file g-guile read)
                         (list (derivation->output-path guile-drv) bash))))))
 
+(test-assertm "gexp->derivation #:references-graphs cross-compilation"
+  ;; The objects passed in #:references-graphs implicitly refer to
+  ;; cross-compiled derivations.  Make sure this is the case.
+  (mlet* %store-monad ((drv1 (lower-object coreutils (%current-system)
+                                           #:target "i586-pc-gnu"))
+                       (drv2 (lower-object coreutils (%current-system)
+                                           #:target #f))
+                       (drv3 (gexp->derivation "three"
+                                               #~(symlink #$coreutils #$output)
+                                               #:target "i586-pc-gnu"
+                                               #:references-graphs
+                                               `(("coreutils" ,coreutils))))
+                       (refs (references* (derivation-file-name drv3))))
+    (return (and (member (derivation-file-name drv1) refs)
+                 (not (member (derivation-file-name drv2) refs))))))
+
 (test-assertm "gexp->derivation #:allowed-references"
   (mlet %store-monad ((drv (gexp->derivation "allowed-refs"
                                              #~(begin