diff options
| -rw-r--r-- | scsh-process.scm | 35 | ||||
| -rw-r--r-- | tests/run.scm | 9 |
2 files changed, 26 insertions, 18 deletions
diff --git a/scsh-process.scm b/scsh-process.scm index 1a6c22b..fd7ff3f 100644 --- a/scsh-process.scm +++ b/scsh-process.scm @@ -177,21 +177,26 @@ (else (syntax-rules () ((_ val) val)))))) (let ((old-handler (workaround (signal-handler signal/chld)))) (lambda (signal) - (for-each (lambda (pid) - (handle-exceptions exn - ;; User might have waited manually - (begin (remove-scsh-pending-process! pid) (void)) - (receive (pid ok? status) - (posix-process-wait pid #t) - (unless (zero? pid) - (let ((p (hash-table-ref *scsh-pending-processes* pid))) - (scsh-process-exit-status-set! p status) - (scsh-process-ok?-set! p ok?) - (condition-variable-broadcast! - (scsh-process-child-condition p)) - ;; The GC can clean it up - (remove-scsh-pending-process! pid)))))) - (hash-table-keys *scsh-pending-processes*)) + ;; Run the signal handler in another thread. This is needed + ;; because the current thread may be waiting on a condition + ;; variable, and we can't wake ourselves up. + (thread-start! + (lambda () + (for-each (lambda (pid) + (handle-exceptions exn + ;; User might have waited manually + (begin (remove-scsh-pending-process! pid) (void)) + (receive (pid ok? status) + (posix-process-wait pid #t) + (unless (zero? pid) + (let ((p (hash-table-ref *scsh-pending-processes* pid))) + (scsh-process-exit-status-set! p status) + (scsh-process-ok?-set! p ok?) + (condition-variable-broadcast! + (scsh-process-child-condition p)) + ;; The GC can clean it up + (remove-scsh-pending-process! pid)))))) + (hash-table-keys *scsh-pending-processes*)))) (when old-handler (old-handler signal))))))) (define (signal-process proc sig) diff --git a/tests/run.scm b/tests/run.scm index f05d643..7690752 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -18,9 +18,12 @@ "This is a test" (run/string* (lambda () (display "This is a test")))) - ;; We must mask sigchld, because otherwise our (wait #f) will fail - ;; due to scsh-process' signal handler possibly reaping the child - ;; before our wait is able to do so. + ;; Ensure all processes up to here have been reaped + (handle-exceptions exn (void) (let lp () (when (wait #f) (lp)))) + + ;; We must mask sigchld, because otherwise our next (wait #f) will + ;; fail due to scsh-process' signal handler possibly reaping the + ;; child before our wait is able to do so. (signal-mask! signal/chld) (test "wait for next process to exit" |