From ca747cf3bd3fbbdd4f9c2b13d8bdc5e69daf8a24 Mon Sep 17 00:00:00 2001
From: Peter Bex <peter@more-magic.net>
Date: Sat, 6 Oct 2012 19:12:21 +0200
Subject: 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...

---
 scsh-process.scm | 28 +++++++++++++++-------------
 1 file changed, 15 insertions(+), 13 deletions(-)

(limited to 'scsh-process.scm')

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
-- 
cgit v1.2.3