tests: Make sure child process of 'pivot-root' test exits.

* tests/syscalls.scm ("pivot-root"): Use 'test-equal'.  Wrap child body
in 'dynamic-wind'.
This commit is contained in:
Ludovic Courtès 2016-10-19 15:30:29 +02:00
parent 0d7034ca4f
commit fe9bdb581e
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -148,11 +148,15 @@
(unless perform-container-tests? (unless perform-container-tests?
(test-skip 1)) (test-skip 1))
(test-assert "pivot-root" (test-equal "pivot-root"
#t
(match (pipe) (match (pipe)
((in . out) ((in . out)
(match (clone (logior CLONE_NEWUSER CLONE_NEWNS SIGCHLD)) (match (clone (logior CLONE_NEWUSER CLONE_NEWNS SIGCHLD))
(0 (0
(dynamic-wind
(const #t)
(lambda ()
(close in) (close in)
(call-with-temporary-directory (call-with-temporary-directory
(lambda (root) (lambda (root)
@ -165,8 +169,9 @@
(pivot-root root put-old) (pivot-root root put-old)
;; The test file should now be located inside the root directory. ;; The test file should now be located inside the root directory.
(write (file-exists? "/test") out) (write (file-exists? "/test") out)
(close out)))) (close out)))))
(primitive-exit 0)) (lambda ()
(primitive-exit 0))))
(pid (pid
(close out) (close out)
(let ((result (read in))) (let ((result (read in)))