diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2020-03-06 11:25:43 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2020-03-12 18:32:15 +0100 |
| commit | cf2ac04f13d9266c7c8a2ebd2e85ef593231ac9d (patch) | |
| tree | 409921980504c7138e4dac8769823fb50becc516 /tests/gexp.scm | |
| parent | be78906592c761aa2a67e979074561e459efdcac (diff) | |
| download | guix-cf2ac04f13d9266c7c8a2ebd2e85ef593231ac9d.tar guix-cf2ac04f13d9266c7c8a2ebd2e85ef593231ac9d.tar.gz | |
gexp: Add 'with-parameters'.
* guix/gexp.scm (<parameterized>): New record type.
(with-parameters): New macro.
(compile-parameterized): New gexp compiler.
* tests/gexp.scm ("with-parameters for %current-system")
("with-parameters for %current-target-system")
("with-parameters + file-append"): New tests.
* doc/guix.texi (G-Expressions): Document it.
Diffstat (limited to 'tests/gexp.scm')
| -rw-r--r-- | tests/gexp.scm | 38 |
1 files changed, 38 insertions, 0 deletions
diff --git a/tests/gexp.scm b/tests/gexp.scm index 9e38816c3d..6a42d3eb57 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -284,6 +284,44 @@ (((thing "out")) (eq? thing file)))))) +(test-assertm "with-parameters for %current-system" + (mlet* %store-monad ((system -> (match (%current-system) + ("aarch64-linux" "x86_64-linux") + (_ "aarch64-linux"))) + (drv (package->derivation coreutils system)) + (obj -> (with-parameters ((%current-system system)) + coreutils)) + (result (lower-object obj))) + (return (string=? (derivation-file-name drv) + (derivation-file-name result))))) + +(test-assertm "with-parameters for %current-target-system" + (mlet* %store-monad ((target -> "riscv64-linux-gnu") + (drv (package->cross-derivation coreutils target)) + (obj -> (with-parameters + ((%current-target-system target)) + coreutils)) + (result (lower-object obj))) + (return (string=? (derivation-file-name drv) + (derivation-file-name result))))) + +(test-assert "with-parameters + file-append" + (let* ((system (match (%current-system) + ("aarch64-linux" "x86_64-linux") + (_ "aarch64-linux"))) + (drv (package-derivation %store coreutils system)) + (param (make-parameter 7)) + (exp #~(here we go #$(with-parameters ((%current-system system) + (param 42)) + (if (= (param) 42) + (file-append coreutils "/bin/touch") + %bootstrap-guile))))) + (match (gexp->sexp* exp) + (('here 'we 'go (? string? result)) + (string=? result + (string-append (derivation->output-path drv) + "/bin/touch")))))) + (test-assert "ungexp + ungexp-native" (let* ((exp (gexp (list (ungexp-native %bootstrap-guile) (ungexp coreutils) |