diff options
| -rw-r--r-- | scsh-process.scm | 3 | ||||
| -rw-r--r-- | tests/run.scm | 12 |
2 files changed, 14 insertions, 1 deletions
diff --git a/scsh-process.scm b/scsh-process.scm index bcc6dbd..a438aa3 100644 --- a/scsh-process.scm +++ b/scsh-process.scm @@ -157,10 +157,11 @@ (process-id pid-or-process))))) (proc (if (process? pid-or-process) pid-or-process - (car proc+condition)))) + (and proc+condition (car proc+condition))))) (when proc+condition (mutex-unlock! m (cdr proc+condition))) (if (or (number? pid-or-process) + (not proc) (not (process-exit-status proc))) (lp) ; could be forcibly unblocked (begin diff --git a/tests/run.scm b/tests/run.scm index 85a6b11..ed4f653 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -4,6 +4,7 @@ (import (scheme base) (scheme write) (scheme read) (chicken base) (chicken port) (chicken condition) (chicken io) (chicken file) (chicken file posix) + (chicken process) (chicken process signal) srfi-18 test) (import scsh-process) @@ -44,6 +45,17 @@ (receive (status2 ok?2 pid2) (wait p) (list (eq? status status2) (eq? ok? ok?2) (or (eq? pid pid2) (list pid pid2))))))) + (let ((p (process-fork (lambda () (sleep 1))))) + (test "after forking via native process-fork, waiting for \"any\" next process still returns the status" + (list 0 #t (process-id p)) + (call-with-values (lambda () (wait #f)) list))) + + ;; Regression test for bug reported by Matt Welland (this broke w/ poule) + (let ((pid (process-fork (lambda () (sleep 1))))) + (test "after forking via native process-fork, waiting for the specific process by pid still returns the status" + (list 0 #t (process-id pid)) + (call-with-values (lambda () (wait (process-id pid))) list))) + (test-assert "signal wasn't unmasked" (signal-masked? signal/chld)) (test "sigchld is masked inside child process" |