diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index 87ed8fce1a91e0a6187bb12c57820601871b1cb6..f16dfb08865f9897facf8ab2c6a0ffc54d4d33cd 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 #(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))) diff --git a/src/lisp/runprog.c b/src/lisp/runprog.c index 4832ff817acacb9d99c77e586e6c9eb1a17b478e..e6a5a0d77ef248c33c8043c2b5538b9278a6ef7b 100644 --- a/src/lisp/runprog.c +++ b/src/lisp/runprog.c @@ -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; +} 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))