Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

3 changed files:

Changes:

  • src/code/run-program.lisp
    ... ... @@ -34,6 +34,12 @@
    34 34 
       (options c-call:int)
    35 35 
       (rusage c-call:int))
    36 36
    37 
    +(alien:def-alien-routine ("prog_status" c-prog-status) c-call:void
    38 
    +  (pid c-call:int :out)
    39 
    +  (what c-call:int :out)
    40 
    +  (code c-call:int :out)
    41 
    +  (corep c-call:int :out))
    42 
    +
    37 43 
     (eval-when (load eval compile)
    38 44 
       (defconstant wait-wnohang #-svr4 1 #+svr4 #o100)
    39 45 
       (defconstant wait-wuntraced #-svr4 2 #+svr4 4)
    ... ... @@ -73,6 +79,16 @@
    73 79 
     		     signal
    74 80 
     		     (not (zerop (ldb (byte 1 7) status)))))))))
    75 81
    82 
    +(defun prog-status ()
    83 
    +  (multiple-value-bind (ret pid what code corep)
    84 
    +      (c-prog-status)
    85 
    +    (declare (ignore ret))
    86 
    +    (when (plusp pid)
    87 
    +      (values pid
    88 
    +	      (aref #(:signaled :stopped :continued :exited) what)
    89 
    +	      code
    90 
    +	      (not (zerop corep))))))
    91 
    +
    76 92
    77 93
    78 94 
     ;;;; Process control stuff.
    ... ... @@ -201,7 +217,8 @@
    201 217 
       (declare (type process proc))
    202 218 
       (let ((status (process-status proc)))
    203 219 
         (if (or (eq status :running)
    204 
    -	    (eq status :stopped))
    220 
    +	    (eq status :stopped)
    221 
    +	    (eq status :continued))
    205 222 
           t
    206 223 
           nil)))
    207 224
    ... ... @@ -235,7 +252,7 @@
    235 252 
     (defun get-processes-status-changes ()
    236 253 
       (loop
    237 254 
         (multiple-value-bind (pid what code core)
    238 
    -			 (wait3 t t)
    255 
    +	(prog-status)
    239 256 
           (unless pid
    240 257 
     	(return))
    241 258 
           (let ((proc (find pid *active-processes* :key #'process-pid)))

  • src/lisp/runprog.c
    ... ... @@ -3,6 +3,8 @@
    3 3 
      *
    4 4 
      */
    5 5
    6 
    +#include <stdio.h>
    7 
    +
    6 8 
     #include <sys/ioctl.h>
    7 9 
     #include <errno.h>
    8 10 
     #include <fcntl.h>
    ... ... @@ -10,6 +12,7 @@
    10 12 
     #include <stdlib.h>
    11 13 
     #include <termios.h>
    12 14 
     #include <unistd.h>
    15 
    +#include <sys/wait.h>
    13 16
    14 17 
     pid_t
    15 18 
     spawn(char *program, char *argv[], char *envp[], char *pty_name,
    ... ... @@ -70,3 +73,64 @@ spawn(char *program, char *argv[], char *envp[], char *pty_name,
    70 73 
         /* The exec didn't work, flame out. */
    71 74 
         exit(1);
    72 75 
     }
    76 
    +
    77 
    +/*
    78 
    + * Call waitpid and return appropriate information about what happened.
    79 
    + *
    80 
    + * what  - int taking the values:
    81 
    + *              0 - ok
    82 
    + *              1 - signaled
    83 
    + *              2 - stopped
    84 
    + *              3 - continued
    85 
    + *              4 - exited
    86 
    + * code   - the terminating signal
    87 
    + * core   - true (non-zero) if a core was produced
    88 
    + */
    89 
    +
    90 
    +/*
    91 
    + * Status codes.  Must be in the same order as in ext::prog-status in
    92 
    + * run-program.lisp
    93 
    + */
    94 
    +enum status_code {
    95 
    +    SIGNALED,
    96 
    +    STOPPED,
    97 
    +    CONTINUED,
    98 
    +    EXITED
    99 
    +};
    100 
    +
    101 
    +void
    102 
    +prog_status(pid_t* pid, int* what, int* code, int* corep)
    103 
    +{
    104 
    +    pid_t w;
    105 
    +    int status;
    106 
    +
    107 
    +    w = waitpid(-1, &status, WNOHANG | WUNTRACED | WCONTINUED);
    108 
    +    *pid = w;
    109 
    +
    110 
    +    if (w == -1) {
    111 
    +
    112 
    +        return;
    113 
    +    }
    114 
    +
    115 
    +    if (WIFEXITED(status)) {
    116 
    +        *what = EXITED;
    117 
    +        *code = WEXITSTATUS(status);
    118 
    +        *corep = 0;
    119 
    +    } else if (WIFSIGNALED(status)) {
    120 
    +        *what = SIGNALED;
    121 
    +        *code = WTERMSIG(status);
    122 
    +        *corep = WCOREDUMP(status);
    123 
    +    } else if (WIFSTOPPED(status)) {
    124 
    +        *what = STOPPED;
    125 
    +        *code = WSTOPSIG(status);
    126 
    +        *corep = 0;
    127 
    +    } else if (WIFCONTINUED(status)) {
    128 
    +        *what = CONTINUED;
    129 
    +        *code = 0;
    130 
    +        *corep = 0;
    131 
    +    } else {
    132 
    +        fprintf(stderr, "pid = %d, status = 0x%x\n", *pid, status);
    133 
    +    }
    134 
    +
    135 
    +    return;
    136 
    +}

  • tests/issues.lisp
    ... ... @@ -367,3 +367,41 @@
    367 367 
           ;; get-universal-time only has an accuracy of 1 sec, just verify
    368 368 
           ;; more than 3 sec have elapsed.
    369 369 
           (assert-true (>= (- (get-universal-time) start-time) 3)))))
    370 
    +
    371 
    +(defun issue-41-tester (stop-signal)
    372 
    +  (let* ((p (ext:run-program "/bin/sleep" '("5") :wait nil))
    373 
    +	 (pid (ext:process-pid p)))
    374 
    +    (flet ((external-kill (pid signal)
    375 
    +	     (ext:run-program "/usr/bin/env"
    376 
    +			  (list "kill"
    377 
    +				(format nil "-~D" signal)
    378 
    +				(format nil "~D" pid)))))
    379 
    +      (assert-eql :running (ext:process-status p))
    380 
    +
    381 
    +      (external-kill pid stop-signal)
    382 
    +      (sleep 1)
    383 
    +      (assert-eql :stopped (ext:process-status p))
    384 
    +
    385 
    +      (external-kill pid unix:sigcont)
    386 
    +      (sleep 1)
    387 
    +      (assert-eql :continued (ext:process-status p))
    388 
    +
    389 
    +      (external-kill pid stop-signal)
    390 
    +      (sleep 1)
    391 
    +      (assert-eql :stopped (ext:process-status p))
    392 
    +
    393 
    +      (external-kill pid unix:sigcont)
    394 
    +      (sleep 1)
    395 
    +      (assert-eql :continued (ext:process-status p))
    396 
    +
    397 
    +      (sleep 5)
    398 
    +      (assert-eql :exited (ext:process-status p)))))
    399 
    +
    400 
    +(define-test issue.41.1
    401 
    +    (:tag :issues)
    402 
    +  (issue-41-tester unix:sigstop))
    403 
    +
    404 
    +#+nil
    405 
    +(define-test issue.41.2
    406 
    +    (:tag :issues)
    407 
    +  (issue-41-tester unix:sigtstp))

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. If you'd like to receive fewer emails, you can adjust your notification settings.