amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

linux-container: Add 'eval/container'.

Browse source 
* gnu/system/linux-container.scm (eval/container): New procedure.
* tests/containers.scm ("eval/container, exit status")
("eval/container, writable user mapping"): New tests.
This commit is contained in:
Ludovic Courtès 2019-07-15 16:14:31 +02:00
parent b41c7beb0b
commit bacfec8611
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 98 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

50
tests/containers.scm
View file

@ -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)