diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2016-10-19 15:30:29 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2016-10-19 15:54:11 +0200 |
| commit | fe9bdb581e6c4a62795f4ced6f4a5a8eab1a34e4 (patch) | |
| tree | 3c9fef10e267b059eb30bb53ce27fb1cfe680574 /tests/syscalls.scm | |
| parent | 0d7034ca4fa287f792a934dd3ac17905db683f4f (diff) | |
tests: Make sure child process of 'pivot-root' test exits.
* tests/syscalls.scm ("pivot-root"): Use 'test-equal'. Wrap child body
in 'dynamic-wind'.
Diffstat (limited to 'tests/syscalls.scm')
| -rw-r--r-- | tests/syscalls.scm | 35 |
1 files changed, 20 insertions, 15 deletions
diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 73fa8a7acfa..1b31d87f230 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm | |||
| @@ -148,25 +148,30 @@ | |||
| 148 | 148 | ||
| 149 | (unless perform-container-tests? | 149 | (unless perform-container-tests? |
| 150 | (test-skip 1)) | 150 | (test-skip 1)) |
| 151 | (test-assert "pivot-root" | 151 | (test-equal "pivot-root" |
| 152 | #t | ||
| 152 | (match (pipe) | 153 | (match (pipe) |
| 153 | ((in . out) | 154 | ((in . out) |
| 154 | (match (clone (logior CLONE_NEWUSER CLONE_NEWNS SIGCHLD)) | 155 | (match (clone (logior CLONE_NEWUSER CLONE_NEWNS SIGCHLD)) |
| 155 | (0 | 156 | (0 |
| 156 | (close in) | 157 | (dynamic-wind |
| 157 | (call-with-temporary-directory | 158 | (const #t) |
| 158 | (lambda (root) | 159 | (lambda () |
| 159 | (let ((put-old (string-append root "/real-root"))) | 160 | (close in) |
| 160 | (mount "none" root "tmpfs") | 161 | (call-with-temporary-directory |
| 161 | (mkdir put-old) | 162 | (lambda (root) |
| 162 | (call-with-output-file (string-append root "/test") | 163 | (let ((put-old (string-append root "/real-root"))) |
| 163 | (lambda (port) | 164 | (mount "none" root "tmpfs") |
| 164 | (display "testing\n" port))) | 165 | (mkdir put-old) |
| 165 | (pivot-root root put-old) | 166 | (call-with-output-file (string-append root "/test") |
| 166 | ;; The test file should now be located inside the root directory. | 167 | (lambda (port) |
| 167 | (write (file-exists? "/test") out) | 168 | (display "testing\n" port))) |
| 168 | (close out)))) | 169 | (pivot-root root put-old) |
| 169 | (primitive-exit 0)) | 170 | ;; The test file should now be located inside the root directory. |
| 171 | (write (file-exists? "/test") out) | ||
| 172 | (close out))))) | ||
| 173 | (lambda () | ||
| 174 | (primitive-exit 0)))) | ||
| 170 | (pid | 175 | (pid |
| 171 | (close out) | 176 | (close out) |
| 172 | (let ((result (read in))) | 177 | (let ((result (read in))) |
