From 961c28aa385d85f5d911369f59dfff703727e5b2 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Sat, 21 Jan 2017 14:16:28 +0100 Subject: Clear pending process table on fork. Thanks to Joerg Wittenberger --- scsh-process.scm | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/scsh-process.scm b/scsh-process.scm index 486adb3..df04bf6 100644 --- a/scsh-process.scm +++ b/scsh-process.scm @@ -74,6 +74,9 @@ (define *scsh-pending-processes* (make-hash-table)) +(define (clear-scsh-pending-processes!) + (set! *scsh-pending-processes* (make-hash-table))) + (define (add-scsh-pending-process! pid) (let ((process (make-scsh-process pid #f #f))) (hash-table-set! *scsh-pending-processes* pid process) @@ -181,12 +184,18 @@ (exit 0))) (define (fork #!optional thunk continue-threads?) - (let ((pid (cond-expand - (has-thread-killer - (process-fork thunk (not continue-threads?))) - (else ;; Ignore both args if thunk is #f, so #f won't be applied - (if thunk (process-fork thunk) (process-fork)))))) - (and (not (zero? pid)) (add-scsh-pending-process! pid)))) + (let* ((thunk (and thunk (lambda () + (clear-scsh-pending-processes!) + (thunk)))) + (pid (cond-expand + (has-thread-killer + (process-fork thunk (not continue-threads?))) + (else ;; Ignore both args if thunk is #f, so #f won't be applied + (if thunk (process-fork thunk) (process-fork)))))) + (cond ((zero? pid) + (clear-scsh-pending-processes!) + #f) + (else (add-scsh-pending-process! pid))))) (define %fork fork) -- cgit v1.2.3