summaryrefslogtreecommitdiff
path: root/scsh-process.scm
diff options
context:
space:
mode:
authorPeter Bex <peter@more-magic.net>2012-10-06 19:12:21 +0200
committerPeter Bex <peter@more-magic.net>2012-10-06 19:12:21 +0200
commitca747cf3bd3fbbdd4f9c2b13d8bdc5e69daf8a24 (patch)
tree844d8ec115eb9fb622cb0c916190933d49e46f4a /scsh-process.scm
parent2c55a49100192f590fbd4b54312e55f79e27c667 (diff)
downloadscsh-process-ca747cf3bd3fbbdd4f9c2b13d8bdc5e69daf8a24.tar.gz
Provide a new 'wait' procedure so we don't need to modify the type of process-wait, which could lead to trouble in user code when compiled with scrutiny and/or specialization. This procedure returns the values in a different order for ease of use. May be a bit confusing...0.3
Diffstat (limited to 'scsh-process.scm')
-rw-r--r--scsh-process.scm28
1 files changed, 15 insertions, 13 deletions
diff --git a/scsh-process.scm b/scsh-process.scm
index c6e4337..b39543f 100644
--- a/scsh-process.scm
+++ b/scsh-process.scm
@@ -45,7 +45,7 @@
run/collecting run/string run/strings run/port run/file run/sexp run/sexps
|| && (& run-final-thunk maybe->string) (run maybe->string) (exec-epf maybe->string)
- process?)
+ process? wait)
(import chicken scheme data-structures)
@@ -77,8 +77,14 @@
(define (remove-scsh-pending-process! pid)
(hash-table-delete! *scsh-pending-processes* pid))
+(define wait #f)
+
(let ((posix-process-wait process-wait))
(set! process-wait
+ (lambda (#!optional pid nohang)
+ (receive (status ok? pid) (wait pid nohang) (values pid ok? status))))
+
+ (set! wait
(lambda (#!optional pid-or-process nohang)
(unless (or (not pid-or-process)
(scsh-process? pid-or-process)
@@ -91,14 +97,14 @@
pid-or-process #f)
pid-or-process)))
(if (and p (scsh-process-exit-status p))
- (values (scsh-process-pid p)
+ (values (scsh-process-exit-status p)
(scsh-process-ok? p)
- (scsh-process-exit-status p))
+ (scsh-process-pid p))
(handle-exceptions exn
(if (and p (scsh-process-exit-status p)) ; Signal might've occurred
- (values (scsh-process-pid p)
+ (values (scsh-process-exit-status p)
(scsh-process-ok? p)
- (scsh-process-exit-status p))
+ (scsh-process-pid p))
(abort exn))
(receive (pid ok? status)
(posix-process-wait (and p (scsh-process-pid p)) nohang)
@@ -107,7 +113,7 @@
(scsh-process-exit-status-set! p status)
(scsh-process-ok?-set! p ok?))
(remove-scsh-pending-process! pid))
- (values pid ok? status)))))))
+ (values status ok? pid)))))))
(set-signal-handler!
signal/chld
@@ -221,9 +227,7 @@
(conns (map (lambda (from-fd temp-file)
(list from-fd (port->fileno temp-file)))
fds temp-files)))
- (receive (pid ok? status)
- (process-wait (fork/pipe+ conns thunk))
- (apply values status temp-files))))
+ (apply values (wait (fork/pipe+ conns thunk)) temp-files)))
(define (run/port* thunk)
(receive (in out)
@@ -243,7 +247,7 @@
(define (run/file* thunk)
(let* ((temp-file (create-temporary-file)))
- (process-wait ; This is peculiar
+ (wait ; This is peculiar
(fork/pipe (lambda ()
(let ((fd (file-open temp-file open/wronly)))
(duplicate-fileno fd 1)
@@ -306,9 +310,7 @@
(define-syntax run
(syntax-rules ()
((_ ?epf ...)
- (receive (pid ok? status)
- (process-wait (& ?epf ...))
- (values status ok? pid)))))
+ (wait (& ?epf ...)))))
;; Perhaps this should really be a procedure?
(define-syntax setup-redirection