Peter Bex  committed a6d0e7a

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...

  • Participants
  • Parent commits 989e400
  • Branches default
  • Tags 0.3

Comments (0)

Files changed (3)

File scsh-process.scm

    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)
 (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)
                                                pid-or-process #f)
             (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)
                         (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)))))))
          (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)
 (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)
 (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

File scsh-process.setup

 ;; -*- Scheme -*-
-(standard-extension 'scsh-process "0.2.1")
+(standard-extension 'scsh-process "0.3")

File tests/run.scm

 (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"))))
   ;; 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)))