summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-07-15 16:14:31 +0200
committerLudovic Courtès <ludo@gnu.org>2019-07-19 11:53:47 +0200
commitbacfec8611530dc3e849fb804b51f50b299796f0 (patch)
tree0d114dfcf5692742ade19a7dfad829b2546835a2 /tests
parentb41c7beb0b5b7a16656d6acf53f77eaf2a58e125 (diff)
linux-container: Add 'eval/container'.
* gnu/system/linux-container.scm (eval/container): New procedure. * tests/containers.scm ("eval/container, exit status") ("eval/container, writable user mapping"): New tests.
Diffstat (limited to 'tests')
-rw-r--r--tests/containers.scm50
1 files changed, 50 insertions, 0 deletions
diff --git a/tests/containers.scm b/tests/containers.scm
index 37408f380d..c6c738f234 100644
--- a/tests/containers.scm
+++ b/tests/containers.scm
@@ -21,7 +21,15 @@
#:use-module (guix utils)
#:use-module (guix build syscalls)
#:use-module (gnu build linux-container)
+ #:use-module ((gnu system linux-container)
+ #:select (eval/container))
#:use-module (gnu system file-systems)
+ #:use-module (guix store)
+ #:use-module (guix monads)
+ #:use-module (guix gexp)
+ #:use-module (guix derivations)
+ #:use-module (guix tests)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-64)
#:use-module (ice-9 match))
@@ -219,4 +227,46 @@
(lambda ()
(* 6 7))))
+(skip-if-unsupported)
+(test-equal "eval/container, exit status"
+ 42
+ (let* ((store (open-connection-for-tests))
+ (status (run-with-store store
+ (eval/container #~(exit 42)))))
+ (close-connection store)
+ (status:exit-val status)))
+
+(skip-if-unsupported)
+(test-assert "eval/container, writable user mapping"
+ (call-with-temporary-directory
+ (lambda (directory)
+ (define store
+ (open-connection-for-tests))
+ (define result
+ (string-append directory "/r"))
+ (define requisites*
+ (store-lift requisites))
+
+ (call-with-output-file result (const #t))
+ (run-with-store store
+ (mlet %store-monad ((status (eval/container
+ #~(begin
+ (use-modules (ice-9 ftw))
+ (call-with-output-file "/result"
+ (lambda (port)
+ (write (scandir #$(%store-prefix))
+ port))))
+ #:mappings
+ (list (file-system-mapping
+ (source result)
+ (target "/result")
+ (writable? #t)))))
+ (reqs (requisites*
+ (list (derivation->output-path
+ (%guile-for-build))))))
+ (close-connection store)
+ (return (and (zero? (pk 'status status))
+ (lset= string=? (cons* "." ".." (map basename reqs))
+ (pk (call-with-input-file result read))))))))))
+
(test-end)