aboutsummaryrefslogtreecommitdiff
path: root/tests/gexp.scm
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2020-03-14 01:42:02 +0100
committerMarius Bakke <mbakke@fastmail.com>2020-03-14 01:42:02 +0100
commitbb4674b43fa413a6d41694b2093c3b00d11eea47 (patch)
treee9de75e813e90459c5313ba73ac22473b0e0e565 /tests/gexp.scm
parent41c6e4f2b40f41cdbf4e8c7ade29845709f9cdf4 (diff)
parent989d564f4434c6e43df7ccb0d1701e89e243e404 (diff)
downloadpatches-bb4674b43fa413a6d41694b2093c3b00d11eea47.tar
patches-bb4674b43fa413a6d41694b2093c3b00d11eea47.tar.gz
Merge branch 'master' into staging
Diffstat (limited to 'tests/gexp.scm')
-rw-r--r--tests/gexp.scm38
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)