diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2024-04-06 23:03:26 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2024-04-08 00:05:48 +0200 |
| commit | b30b838d5055e36be19d030db28838fec4474d98 (patch) | |
| tree | 9348f47514b74687ea06e6263d62183c20259128 /tests/gexp.scm | |
| parent | a7f15c9ecffc1762f5886fb5a2a14490e2994c8c (diff) | |
gexp: Add #:guile parameter to ‘gexp->file’ and ‘scheme-file’.
This brings ‘gexp->file’ in line with its documentation and mirrors
what’s done for ‘gexp->script’ and ‘program-file’.
Fixes <https://issues.guix.gnu.org/69401>.
* guix/gexp.scm (gexp->file): Add #:guile, as was already documented.
(<scheme-file>)[guile]: New field.
(scheme-file): Add #:guile.
(scheme-file-compiler): Honor ‘guile’ field.
* tests/gexp.scm ("gexp->file")
("gexp->file + file-append", "gexp->file + #:splice?")
("gexp->file, cross-compilation")
("gexp->file, cross-compilation with default target")
Add #:guile to ‘gexp->file’ calls.
("gexp-modules deletes duplicates")
("gexp->derivation & with-imported-module & computed module")
("gexp->derivation & with-extensions", "scheme-file"): Likewise for
‘scheme-file’ calls.
Change-Id: I47536063d5e411e561ec321e535267e92dd06044
Reported-by: Efraim Flashner <efraim@flashner.co.il>
Change-Id: I58d653c7fbe65c665bafcbd332ac9b264ddeab64
Diffstat (limited to 'tests/gexp.scm')
| -rw-r--r-- | tests/gexp.scm | 31 |
1 files changed, 21 insertions, 10 deletions
diff --git a/tests/gexp.scm b/tests/gexp.scm index 001786c13c7..905009caeee 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2014-2023 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2014-2024 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; Copyright © 2021-2022 Maxime Devos <maximedevos@telenet.be> | 3 | ;;; Copyright © 2021-2022 Maxime Devos <maximedevos@telenet.be> |
| 4 | ;;; | 4 | ;;; |
| 5 | ;;; This file is part of GNU Guix. | 5 | ;;; This file is part of GNU Guix. |
| @@ -661,7 +661,8 @@ | |||
| 661 | (mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile)))) | 661 | (mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile)))) |
| 662 | (guile (package-file %bootstrap-guile)) | 662 | (guile (package-file %bootstrap-guile)) |
| 663 | (sexp (gexp->sexp exp (%current-system) #f)) | 663 | (sexp (gexp->sexp exp (%current-system) #f)) |
| 664 | (drv (gexp->file "foo" exp)) | 664 | (drv (gexp->file "foo" exp |
| 665 | #:guile %bootstrap-guile)) | ||
| 665 | (out -> (derivation->output-path drv)) | 666 | (out -> (derivation->output-path drv)) |
| 666 | (done (built-derivations (list drv))) | 667 | (done (built-derivations (list drv))) |
| 667 | (refs (references* out))) | 668 | (refs (references* out))) |
| @@ -672,7 +673,8 @@ | |||
| 672 | (mlet* %store-monad ((exp -> #~#$(file-append %bootstrap-guile | 673 | (mlet* %store-monad ((exp -> #~#$(file-append %bootstrap-guile |
| 673 | "/bin/guile")) | 674 | "/bin/guile")) |
| 674 | (guile (package-file %bootstrap-guile)) | 675 | (guile (package-file %bootstrap-guile)) |
| 675 | (drv (gexp->file "foo" exp)) | 676 | (drv (gexp->file "foo" exp |
| 677 | #:guile %bootstrap-guile)) | ||
| 676 | (out -> (derivation->output-path drv)) | 678 | (out -> (derivation->output-path drv)) |
| 677 | (done (built-derivations (list drv))) | 679 | (done (built-derivations (list drv))) |
| 678 | (refs (references* out))) | 680 | (refs (references* out))) |
| @@ -685,7 +687,9 @@ | |||
| 685 | #~(define foo 'bar) | 687 | #~(define foo 'bar) |
| 686 | #~(define guile #$%bootstrap-guile))) | 688 | #~(define guile #$%bootstrap-guile))) |
| 687 | (guile (package-file %bootstrap-guile)) | 689 | (guile (package-file %bootstrap-guile)) |
| 688 | (drv (gexp->file "splice" exp #:splice? #t)) | 690 | (drv (gexp->file "splice" exp |
| 691 | #:splice? #t | ||
| 692 | #:guile %bootstrap-guile)) | ||
| 689 | (out -> (derivation->output-path drv)) | 693 | (out -> (derivation->output-path drv)) |
| 690 | (done (built-derivations (list drv))) | 694 | (done (built-derivations (list drv))) |
| 691 | (refs (references* out))) | 695 | (refs (references* out))) |
| @@ -943,7 +947,8 @@ | |||
| 943 | (let ((make-file (lambda () | 947 | (let ((make-file (lambda () |
| 944 | ;; Use 'eval' to make sure we get an object that's not | 948 | ;; Use 'eval' to make sure we get an object that's not |
| 945 | ;; 'eq?' nor 'equal?' due to the closures it embeds. | 949 | ;; 'eq?' nor 'equal?' due to the closures it embeds. |
| 946 | (eval '(scheme-file "bar.scm" #~(define-module (bar))) | 950 | (eval '(scheme-file "bar.scm" #~(define-module (bar)) |
| 951 | #:guile %bootstrap-guile) | ||
| 947 | (current-module))))) | 952 | (current-module))))) |
| 948 | (define result | 953 | (define result |
| 949 | ((@@ (guix gexp) gexp-modules) | 954 | ((@@ (guix gexp) gexp-modules) |
| @@ -1035,7 +1040,8 @@ importing.* \\(guix config\\) from the host" | |||
| 1035 | #:export (the-answer)) | 1040 | #:export (the-answer)) |
| 1036 | 1041 | ||
| 1037 | (define the-answer 42)) | 1042 | (define the-answer 42)) |
| 1038 | #:splice? #t)) | 1043 | #:splice? #t |
| 1044 | #:guile %bootstrap-guile)) | ||
| 1039 | (build -> (with-imported-modules `(((foo bar) => ,module) | 1045 | (build -> (with-imported-modules `(((foo bar) => ,module) |
| 1040 | (guix build utils)) | 1046 | (guix build utils)) |
| 1041 | #~(begin | 1047 | #~(begin |
| @@ -1080,7 +1086,8 @@ importing.* \\(guix config\\) from the host" | |||
| 1080 | 1086 | ||
| 1081 | (define (multiply x) | 1087 | (define (multiply x) |
| 1082 | (* the-answer x))) | 1088 | (* the-answer x))) |
| 1083 | #:splice? #t)) | 1089 | #:splice? #t |
| 1090 | #:guile %bootstrap-guile)) | ||
| 1084 | (build -> (with-extensions (list extension) | 1091 | (build -> (with-extensions (list extension) |
| 1085 | (with-imported-modules `((guix build utils) | 1092 | (with-imported-modules `((guix build utils) |
| 1086 | ((foo) => ,module)) | 1093 | ((foo) => ,module)) |
| @@ -1432,7 +1439,8 @@ importing.* \\(guix config\\) from the host" | |||
| 1432 | 1439 | ||
| 1433 | (test-assertm "scheme-file" | 1440 | (test-assertm "scheme-file" |
| 1434 | (let* ((text (plain-file "foo" "Hello, world!")) | 1441 | (let* ((text (plain-file "foo" "Hello, world!")) |
| 1435 | (scheme (scheme-file "bar" #~(list "foo" #$text)))) | 1442 | (scheme (scheme-file "bar" #~(list "foo" #$text) |
| 1443 | #:guile %bootstrap-guile))) | ||
| 1436 | (mlet* %store-monad ((drv (lower-object scheme)) | 1444 | (mlet* %store-monad ((drv (lower-object scheme)) |
| 1437 | (text (lower-object text)) | 1445 | (text (lower-object text)) |
| 1438 | (out -> (derivation->output-path drv))) | 1446 | (out -> (derivation->output-path drv))) |
| @@ -1719,7 +1727,9 @@ importing.* \\(guix config\\) from the host" | |||
| 1719 | (test-assertm "gexp->file, cross-compilation" | 1727 | (test-assertm "gexp->file, cross-compilation" |
| 1720 | (mlet* %store-monad ((target -> "aarch64-linux-gnu") | 1728 | (mlet* %store-monad ((target -> "aarch64-linux-gnu") |
| 1721 | (exp -> (gexp (list (ungexp coreutils)))) | 1729 | (exp -> (gexp (list (ungexp coreutils)))) |
| 1722 | (xdrv (gexp->file "foo" exp #:target target)) | 1730 | (xdrv (gexp->file "foo" exp |
| 1731 | #:target target | ||
| 1732 | #:guile %bootstrap-guile)) | ||
| 1723 | (refs (references* | 1733 | (refs (references* |
| 1724 | (derivation-file-name xdrv))) | 1734 | (derivation-file-name xdrv))) |
| 1725 | (xcu (package->cross-derivation coreutils | 1735 | (xcu (package->cross-derivation coreutils |
| @@ -1732,7 +1742,8 @@ importing.* \\(guix config\\) from the host" | |||
| 1732 | (mlet* %store-monad ((target -> "aarch64-linux-gnu") | 1742 | (mlet* %store-monad ((target -> "aarch64-linux-gnu") |
| 1733 | (_ (set-current-target target)) | 1743 | (_ (set-current-target target)) |
| 1734 | (exp -> (gexp (list (ungexp coreutils)))) | 1744 | (exp -> (gexp (list (ungexp coreutils)))) |
| 1735 | (xdrv (gexp->file "foo" exp)) | 1745 | (xdrv (gexp->file "foo" exp |
| 1746 | #:guile %bootstrap-guile)) | ||
| 1736 | (refs (references* | 1747 | (refs (references* |
| 1737 | (derivation-file-name xdrv))) | 1748 | (derivation-file-name xdrv))) |
| 1738 | (xcu (package->cross-derivation coreutils | 1749 | (xcu (package->cross-derivation coreutils |
