diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index 87ed8fce1a91e0a6187bb12c57820601871b1cb6..5a7f6e1e0de3a53292975571821a21c7156376ef 100644 --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -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 #(:signaled :stopped :continued :exited) what) + code + (not (zerop corep)))))) + ;;;; Process control stuff. @@ -201,7 +217,8 @@ (declare (type process proc)) (let ((status (process-status proc))) (if (or (eq status :running) - (eq status :stopped)) + (eq status :stopped) + (eq status :continued)) t nil))) @@ -235,7 +252,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))) diff --git a/src/lisp/runprog.c b/src/lisp/runprog.c index 4832ff817acacb9d99c77e586e6c9eb1a17b478e..852584a83eb881134419bcc746902a87ea45ca04 100644 --- a/src/lisp/runprog.c +++ b/src/lisp/runprog.c @@ -3,6 +3,8 @@ * */ +#include <stdio.h> + #include <sys/ioctl.h> #include <errno.h> #include <fcntl.h> @@ -10,6 +12,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 +73,64 @@ 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 + */ + +/* + * Status codes. Must be in the same order as in ext::prog-status in + * run-program.lisp + */ +enum status_code { + SIGNALED, + STOPPED, + CONTINUED, + EXITED +}; + +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 = EXITED; + *code = WEXITSTATUS(status); + *corep = 0; + } else if (WIFSIGNALED(status)) { + *what = SIGNALED; + *code = WTERMSIG(status); + *corep = WCOREDUMP(status); + } else if (WIFSTOPPED(status)) { + *what = STOPPED; + *code = WSTOPSIG(status); + *corep = 0; + } else if (WIFCONTINUED(status)) { + *what = CONTINUED; + *code = 0; + *corep = 0; + } else { + fprintf(stderr, "pid = %d, status = 0x%x\n", *pid, status); + } + + return; +} diff --git a/tests/issues.lisp b/tests/issues.lisp index 0cff9c13935bb8ec8048042aafc8891af0fdb6f3..1af498f42ec769286ad0186c2867cfdfacb28508 100644 --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -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))