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

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)