~ruther/guix-local

fe9bdb581e6c4a62795f4ced6f4a5a8eab1a34e4 — Ludovic Courtès 9 years ago 0d7034c
tests: Make sure child process of 'pivot-root' test exits.

* tests/syscalls.scm ("pivot-root"): Use 'test-equal'.  Wrap child body
in 'dynamic-wind'.
1 files changed, 20 insertions(+), 15 deletions(-)

M tests/syscalls.scm
M tests/syscalls.scm => tests/syscalls.scm +20 -15
@@ 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)))