summaryrefslogtreecommitdiff
path: root/gnu/tests/base.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-08-28 09:54:03 +0200
committerLudovic Courtès <ludo@gnu.org>2017-08-28 09:56:33 +0200
commit7f090203d5fb033eb1b64778b03afad5bb35f5f2 (patch)
tree7c979b613c059c60eaafb75806bb362ae5947483 /gnu/tests/base.scm
parent06b8eae3d101b9c1f237de34f21091e085390e11 (diff)
services: user-processes: Reap child processes.
Fixes <http://bugs.gnu.org/26931>. Reported by Leo Famulari <leo@famulari.name>. * gnu/services/base.scm (user-processes-service-type)[stop]: Add 'reap-children' loop. * gnu/tests/base.scm (run-halt-test): New procedure. (%test-halt): New variable.
Diffstat (limited to 'gnu/tests/base.scm')
-rw-r--r--gnu/tests/base.scm83
1 files changed, 83 insertions, 0 deletions
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 6132aa96ef..5b40d4514a 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -32,12 +32,15 @@
#:use-module (gnu packages imagemagick)
#:use-module (gnu packages ocr)
#:use-module (gnu packages package-management)
+ #:use-module (gnu packages linux)
+ #:use-module (gnu packages tmux)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix packages)
#:use-module (srfi srfi-1)
#:export (run-basic-test
%test-basic-os
+ %test-halt
%test-mcron
%test-nss-mdns))
@@ -405,6 +408,86 @@ functionality tests.")
;;;
+;;; Halt.
+;;;
+
+(define (run-halt-test vm)
+ ;; As reported in <http://bugs.gnu.org/26931>, running tmux would previously
+ ;; lead the 'stop' method of 'user-processes' to an infinite loop, with the
+ ;; tmux server process as a zombie that remains in the list of processes.
+ ;; This test reproduces this scenario.
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (gnu build marionette))
+
+ (define marionette
+ (make-marionette '(#$vm)))
+
+ (define ocrad
+ #$(file-append ocrad "/bin/ocrad"))
+
+ ;; Wait for tty1 and log in.
+ (marionette-eval '(begin
+ (use-modules (gnu services herd))
+ (start-service 'term-tty1))
+ marionette)
+ (marionette-type "root\n" marionette)
+ (wait-for-screen-text marionette
+ (lambda (text)
+ (string-contains text "root@komputilo"))
+ #:ocrad ocrad)
+
+ ;; Start tmux and wait for it to be ready.
+ (marionette-type "tmux new-session 'echo 1 > /ready; bash'\n"
+ marionette)
+ (wait-for-file "/ready" marionette)
+
+ ;; Make sure to stop the test after a while.
+ (sigaction SIGALRM (lambda _
+ (format (current-error-port)
+ "FAIL: Time is up, but VM still running.\n")
+ (primitive-exit 1)))
+ (alarm 10)
+
+ ;; Get debugging info.
+ (marionette-eval '(current-output-port
+ (open-file "/dev/console" "w0"))
+ marionette)
+ (marionette-eval '(system* #$(file-append procps "/bin/ps")
+ "-eo" "pid,ppid,stat,comm")
+ marionette)
+
+ ;; See if 'halt' actually works.
+ (marionette-eval '(system* "/run/current-system/profile/sbin/halt")
+ marionette)
+
+ ;; If we reach this line, that means the VM was properly stopped in
+ ;; a timely fashion.
+ (alarm 0)
+ (call-with-output-file #$output
+ (lambda (port)
+ (display "success!" port))))))
+
+ (gexp->derivation "halt" test))
+
+(define %test-halt
+ (system-test
+ (name "halt")
+ (description
+ "Use the 'halt' command and make sure it succeeds and does not get stuck
+in a loop. See <http://bugs.gnu.org/26931>.")
+ (value
+ (let ((os (marionette-operating-system
+ (operating-system
+ (inherit %simple-os)
+ (packages (cons tmux %base-packages)))
+ #:imported-modules '((gnu services herd)
+ (guix combinators)))))
+ (run-halt-test (virtual-machine os))))))
+
+
+;;;
;;; Mcron.
;;;