Clear pending process table on fork.

Thanks to Joerg Wittenberger

1 files 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)