;;; 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.
;;;
\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!"))))
(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