epiphany w/ gtk4 and webkitgtk 2.38

[jackhill/guix/guix.git] / tests / containers.scm

diff --git a/tests/containers.scm b/tests/containers.scm
index 37408f3..608902c 100644 (file)
--- 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))
 
@@ -125,6 +133,14 @@
      (lambda ()
        (primitive-exit 0)))))
 
+(skip-if-unsupported)
+(test-assert "call-with-container, mnt namespace, root permissions"
+  (zero?
+   (call-with-container '()
+     (lambda ()
+       (assert-exit (= #o755 (stat:perms (lstat "/")))))
+     #:namespaces '(user mnt))))
+
 (skip-if-unsupported)
 (test-assert "container-excursion"
   (call-with-temporary-directory
@@ -219,4 +235,74 @@
     (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))))))))))
+
+(skip-if-unsupported)
+(test-assert "eval/container, non-empty load path"
+  (call-with-temporary-directory
+   (lambda (directory)
+     (define store
+       (open-connection-for-tests))
+     (define result
+       (string-append directory "/r"))
+     (define requisites*
+       (store-lift requisites))
+
+     (mkdir result)
+     (run-with-store store
+       (mlet %store-monad ((status (eval/container
+                                    (with-imported-modules '((guix build utils))
+                                      #~(begin
+                                          (use-modules (guix build utils))
+                                          (mkdir-p "/result/a/b/c")))
+                                    #:mappings
+                                    (list (file-system-mapping
+                                           (source result)
+                                           (target "/result")
+                                           (writable? #t))))))
+         (close-connection store)
+         (return (and (zero? status)
+                      (file-is-directory?
+                       (string-append result "/a/b/c")))))))))
+
 (test-end)