summaryrefslogtreecommitdiff
path: root/scsh-process.scm
diff options
context:
space:
mode:
authorPeter Bex <peter@more-magic.net>2017-01-21 14:16:28 +0100
committerPeter Bex <peter@more-magic.net>2017-01-21 14:16:28 +0100
commit961c28aa385d85f5d911369f59dfff703727e5b2 (patch)
treea406773477c8faf8d8a91947b63d03f08638cc0f /scsh-process.scm
parenta7c1af60a7296a008d5cc4fbed9c82afdda01fcd (diff)
downloadscsh-process-961c28aa385d85f5d911369f59dfff703727e5b2.tar.gz
Clear pending process table on fork.
Thanks to Joerg Wittenberger
Diffstat (limited to 'scsh-process.scm')
-rw-r--r--scsh-process.scm21
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)