ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 05:48:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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
1 changed files with 20 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
tests/syscalls.scm
View file

@ -148,25 +148,30 @@ (define perform-container-tests?
(unless perform-container-tests?
(test-skip 1))
(test-assert "pivot-root"
(test-equal "pivot-root"
#t
(match (pipe)
((in . out)
(match (clone (logior CLONE_NEWUSER CLONE_NEWNS SIGCHLD))
(0
(close in)
(call-with-temporary-directory
(lambda (root)
(let ((put-old (string-append root "/real-root")))
(mount "none" root "tmpfs")
(mkdir put-old)
(call-with-output-file (string-append root "/test")
(lambda (port)
(display "testing\n" port)))
(pivot-root root put-old)
;; The test file should now be located inside the root directory.
(write (file-exists? "/test") out)
(close out))))
(primitive-exit 0))
(dynamic-wind
(const #t)
(lambda ()
(close in)
(call-with-temporary-directory
(lambda (root)
(let ((put-old (string-append root "/real-root")))
(mount "none" root "tmpfs")
(mkdir put-old)
(call-with-output-file (string-append root "/test")
(lambda (port)
(display "testing\n" port)))
(pivot-root root put-old)
;; The test file should now be located inside the root directory.
(write (file-exists? "/test") out)
(close out)))))
(lambda ()
(primitive-exit 0))))
(pid
(close out)
(let ((result (read in)))