diff options
Diffstat (limited to 'tests/gexp.scm')
| -rw-r--r-- | tests/gexp.scm | 81 |
1 files changed, 76 insertions, 5 deletions
diff --git a/tests/gexp.scm b/tests/gexp.scm index ad8e1d57b8..c80ca13fab 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2021 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> +;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2021-2022 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -28,6 +28,7 @@ #:use-module (guix tests) #:use-module ((guix build utils) #:select (with-directory-excursion)) #:use-module ((guix utils) #:select (call-with-temporary-directory)) + #:use-module ((guix ui) #:select (load*)) #:use-module (gnu packages) #:use-module (gnu packages base) #:use-module (gnu packages bootstrap) @@ -120,6 +121,19 @@ (let ((inside (file-append coreutils "/bin/hello"))) (gexp->approximate-sexp #~(display '#$inside)))) +;; See <https://issues.guix.gnu.org/54236>. +(test-equal "unquoted sexp (not a gexp!)" + '(list #(foo) (foo) () "foo" foo #xf00) + (let ((inside/vector #(foo)) + (inside/list '(foo)) + (inside/empty '()) + (inside/string "foo") + (inside/symbol 'foo) + (inside/number #xf00)) + (gexp->approximate-sexp + #~(list #$inside/vector #$inside/list #$inside/empty #$inside/string + #$inside/symbol #$inside/number)))) + (test-equal "no refs" '(display "hello!") (let ((exp (gexp (display "hello!")))) @@ -134,6 +148,11 @@ (null? (gexp-inputs exp)) (gexp->sexp* exp)))) +(test-equal "gexp->approximate-sexp, outputs" + '(list 'out:foo (*approximate*) 'out:bar (*approximate*)) + (gexp->approximate-sexp + #~(list 'out:foo #$output:foo 'out:bar #$output:bar))) + (test-equal "unquote" '(display `(foo ,(+ 2 3))) (let ((exp (gexp (display `(foo ,(+ 2 3)))))) @@ -222,6 +241,32 @@ (let ((file (local-file (string-copy "../base32.scm")))) (local-file-absolute-file-name file))))) +(test-assert "local-file, relative file name, within gexp" + (let* ((file (search-path %load-path "guix/base32.scm")) + (interned (add-to-store %store "base32.scm" #f "sha256" file))) + (equal? `(the file is ,interned) + (gexp->sexp* + #~(the file is #$(local-file "../guix/base32.scm")))))) + +(test-assert "local-file, relative file name, within gexp, compiled" + ;; In Guile 3.0.8, everything read by the #~ and #$ read hash extensions + ;; would lack source location info, which in turn would lead + ;; (current-source-directory), called by 'local-file', to return #f, thereby + ;; breaking 'local-file' resolution. See + ;; <https://issues.guix.gnu.org/54003>. + (let ((file (tmpnam))) + (call-with-output-file file + (lambda (port) + (display (string-append "#~(this file is #$(local-file \"" + (basename file) "\" \"t.scm\"))") + port))) + + (let* ((interned (add-to-store %store "t.scm" #f "sha256" file)) + (module (make-fresh-user-module))) + (module-use! module (resolve-interface '(guix gexp))) + (equal? `(this file is ,interned) + (gexp->sexp* (load* file module)))))) + (test-assertm "local-file, #:select?" (mlet* %store-monad ((select? -> (lambda (file stat) (member (basename file) @@ -1413,6 +1458,7 @@ importing.* \\(guix config\\) from the host" (test-assertm "mixed-text-file" (mlet* %store-monad ((file -> (mixed-text-file "mixed" + #:guile %bootstrap-guile "export PATH=" %bootstrap-guile "/bin")) (drv (lower-object file)) @@ -1430,7 +1476,8 @@ importing.* \\(guix config\\) from the host" (mlet* %store-monad ((union -> (file-union "union" `(("a" ,(plain-file "a" "1")) ("b/c/d" ,(plain-file "d" "2")) - ("e" ,(plain-file "e" "3"))))) + ("e" ,(plain-file "e" "3"))) + #:guile %bootstrap-guile)) (drv (lower-object union)) (out -> (derivation->output-path drv))) (define (contents=? file str) @@ -1469,7 +1516,8 @@ importing.* \\(guix config\\) from the host" (symlink #$%bootstrap-guile (string-append #$output "/guile")) (symlink #$text (string-append #$output "/text")))) - (computed (computed-file "computed" exp))) + (computed (computed-file "computed" exp + #:guile %bootstrap-guile))) (mlet* %store-monad ((text (lower-object text)) (guile-drv (lower-object %bootstrap-guile)) (comp-drv (lower-object computed)) @@ -1504,7 +1552,8 @@ importing.* \\(guix config\\) from the host" (display item port)))))) (computed (computed-file "computed" exp #:options - `(#:references-graphs (("graph" ,pkg))))) + `(#:references-graphs (("graph" ,pkg))) + #:guile %bootstrap-guile)) (drv0 (package-derivation %store pkg #:graft? #t)) (drv1 (parameterize ((%graft? #t)) (run-with-store %store @@ -1535,6 +1584,28 @@ importing.* \\(guix config\\) from the host" (cons (derivation-file-name drv) refs)))))))) +(test-assertm "lower-object, computed-file, #:target" + (let* ((target "i586-pc-gnu") + (computed (computed-file "computed-cross" + #~(symlink #$coreutils output) + #:guile (default-guile)))) + ;; When lowered to TARGET, the derivation of COMPUTED should run natively, + ;; using a native Guile, but it should refer to the target COREUTILS. + (mlet* %store-monad ((drv (lower-object computed (%current-system) + #:target target)) + (refs (references* (derivation-file-name drv))) + (guile (lower-object (default-guile) + (%current-system) + #:target #f)) + (cross (lower-object coreutils #:target target)) + (native (lower-object coreutils #:target #f))) + (return (and (string=? (derivation-system (pk 'drv drv)) (%current-system)) + (string=? (derivation-builder drv) + (string-append (derivation->output-path guile) + "/bin/guile")) + (not (member (derivation-file-name native) refs)) + (member (derivation-file-name cross) refs)))))) + (test-assert "lower-object & gexp-input-error?" (guard (c ((gexp-input-error? c) (gexp-error-invalid-input c))) |