diff options
| -rw-r--r-- | scsh-process.scm | 28 | ||||
| -rw-r--r-- | scsh-process.setup | 2 | ||||
| -rw-r--r-- | tests/run.scm | 11 |
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) |