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

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit fe9bdb581e6c4a62795f4ced6f4a5a8eab1a34e4
Author: Ludovic Courtès <address@hidden>
Date:   Wed Oct 19 15:30:29 2016 +0200

    tests: Make sure child process of 'pivot-root' test exits.
    
    * tests/syscalls.scm ("pivot-root"): Use 'test-equal'.  Wrap child body
    in 'dynamic-wind'.
---
 tests/syscalls.scm |   35 ++++++++++++++++++++---------------
 1 file changed, 20 insertions(+), 15 deletions(-)

diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 73fa8a7..1b31d87 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -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)))