Skip to content
Snippets Groups Projects
Commit f05cb10a authored by Raymond Toy's avatar Raymond Toy
Browse files

Fix #41: Report proper process status

The main problem is that we weren't calling wait3 with WCONTINUED so
that we would be signaled when the process continues.  And we also
need to check that result of wait call was WCONTINUED>

Replace the wait3 routine with a C routine (prog_status) so we don't
have to deal with the OS-specific flags.  This function basically
returns what the lisp function wait3 did.

Use this function in GET-PROCESSES-STATUS-CHANGES.

 - runprog.c:
   - Add prog_status
 - run-program.lisp:
   - Use prog_status instead of wait3
 - issues.lisp:
   - Add basic test
parent 4acd1d80
No related branches found
No related tags found
No related merge requests found
......@@ -34,6 +34,12 @@
(options c-call:int)
(rusage c-call:int))
(alien:def-alien-routine ("prog_status" c-prog-status) c-call:void
(pid c-call:int :out)
(what c-call:int :out)
(code c-call:int :out)
(corep c-call:int :out))
(eval-when (load eval compile)
(defconstant wait-wnohang #-svr4 1 #+svr4 #o100)
(defconstant wait-wuntraced #-svr4 2 #+svr4 4)
......@@ -73,6 +79,16 @@
signal
(not (zerop (ldb (byte 1 7) status)))))))))
(defun prog-status ()
(multiple-value-bind (ret pid what code corep)
(c-prog-status)
(declare (ignore ret))
(when (plusp pid)
(values pid
(aref #(nil :signaled :stopped :continued :exited) what)
code
(not (zerop corep))))))
;;;; Process control stuff.
......@@ -235,7 +251,7 @@
(defun get-processes-status-changes ()
(loop
(multiple-value-bind (pid what code core)
(wait3 t t)
(prog-status)
(unless pid
(return))
(let ((proc (find pid *active-processes* :key #'process-pid)))
......
......@@ -10,6 +10,7 @@
#include <stdlib.h>
#include <termios.h>
#include <unistd.h>
#include <sys/wait.h>
pid_t
spawn(char *program, char *argv[], char *envp[], char *pty_name,
......@@ -70,3 +71,51 @@ spawn(char *program, char *argv[], char *envp[], char *pty_name,
/* The exec didn't work, flame out. */
exit(1);
}
/*
* Call waitpid and return appropriate information about what happened.
*
* what - int taking the values:
* 0 - ok
* 1 - signaled
* 2 - stopped
* 3 - continued
* 4 - exited
* code - the terminating signal
* core - true (non-zero) if a core was produced
*/
void
prog_status(pid_t* pid, int* what, int* code, int* corep)
{
pid_t w;
int status;
w = waitpid(-1, &status, WNOHANG | WUNTRACED | WCONTINUED);
*pid = w;
if (w == -1) {
return;
}
if (WIFEXITED(status)) {
*what = 4;
*code = WEXITSTATUS(status);
*corep = 0;
} else if (WIFSIGNALED(status)) {
*what = 1;
*code = WTERMSIG(status);
*corep = WCOREDUMP(status);
} else if (WIFSTOPPED(status)) {
*what = 2;
*code = WSTOPSIG(status);
*corep = 0;
} else if (WIFCONTINUED(status)) {
*what = 3;
*code = 0;
*corep = 0;
}
return;
}
......@@ -367,3 +367,41 @@
;; get-universal-time only has an accuracy of 1 sec, just verify
;; more than 3 sec have elapsed.
(assert-true (>= (- (get-universal-time) start-time) 3)))))
(defun issue-41-tester (stop-signal)
(let* ((p (ext:run-program "/bin/sleep" '("5") :wait nil))
(pid (ext:process-pid p)))
(flet ((external-kill (pid signal)
(ext:run-program "/usr/bin/env"
(list "kill"
(format nil "-~D" signal)
(format nil "~D" pid)))))
(assert-eql :running (ext:process-status p))
(external-kill pid stop-signal)
(sleep 1)
(assert-eql :stopped (ext:process-status p))
(external-kill pid unix:sigcont)
(sleep 1)
(assert-eql :continued (ext:process-status p))
(external-kill pid stop-signal)
(sleep 1)
(assert-eql :stopped (ext:process-status p))
(external-kill pid unix:sigcont)
(sleep 1)
(assert-eql :continued (ext:process-status p))
(sleep 5)
(assert-eql :exited (ext:process-status p)))))
(define-test issue.41.1
(:tag :issues)
(issue-41-tester unix:sigstop))
#+nil
(define-test issue.41.2
(:tag :issues)
(issue-41-tester unix:sigtstp))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment