guix
/
guix
mirror of git://git.savannah.gnu.org/guix.git
3
4
Fork 0
Code Issues Releases Wiki Activity

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