summaryrefslogtreecommitdiff
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
parent2c55a49100192f590fbd4b54312e55f79e27c667 (diff)
downloadscsh-process-0.3.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
-rw-r--r--scsh-process.scm28
-rw-r--r--scsh-process.setup2
-rw-r--r--tests/run.scm11
3 files changed, 21 insertions, 20 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
diff --git a/scsh-process.setup b/scsh-process.setup
index 0c575c4..a0232e2 100644
--- a/scsh-process.setup
+++ b/scsh-process.setup
@@ -1,3 +1,3 @@
;; -*- Scheme -*-
-(standard-extension 'scsh-process "0.2.1")
+(standard-extension 'scsh-process "0.3")
diff --git a/tests/run.scm b/tests/run.scm
index 56a823e..ae12600 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -7,13 +7,13 @@
(test-group "Procedural interface"
(test "Fork/pipe \"hello world\" example from SCSH reference manual"
- "Hello, world."
- (begin (process-wait
- (fork/pipe
+ '(0 #t "Hello, world.")
+ (receive (exit-status exited-ok? pid)
+ (wait (fork/pipe
(lambda ()
(with-output-to-port (open-output-file* 1)
(lambda () (display "Hello, world.\n"))))))
- (read-line (open-input-file* 0))))
+ (list exit-status exited-ok? (read-line (open-input-file* 0)))))
(test "run/string* returns a string output in a subprocess"
"This is a test"
(run/string* (lambda () (display "This is a test"))))
@@ -127,8 +127,7 @@
;; TODO: Find a way to test that the input port didn't get replaced by
;; one from a subshell. This happened before, but not sure how
;; to detect this except running it manually from the REPL.
- (test-error "No more zombies lying around after we're done"
- (process-wait)))
+ (test-error "No more zombies lying around after we're done" (wait)))
(test-end)