>From 9efeeaa5ea68c9423e7460d248c9117e07dbe512 Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Wed, 3 Oct 2012 22:22:55 +0200
Subject: [PATCH] Fix handling of EINTR in process-wait by retrying.  Add
 combined test for this and the getc() EINTR handling bug

---
 NEWS                 |    5 +++++
 posixunix.scm        |   19 +++++++++++--------
 tests/port-tests.scm |   21 +++++++++++++++++++++
 3 files changed, 37 insertions(+), 8 deletions(-)

diff --git a/NEWS b/NEWS
index efe430e..226d244 100644
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,8 @@
+4.8.1
+
+- Core libraries
+  - Fixed EINTR handling in process-wait and when reading from file ports.
+
 4.8.0
 
 - Security fixes
diff --git a/posixunix.scm b/posixunix.scm
index c851319..77d8bca 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -1808,14 +1808,17 @@ EOF
 
 (define (##sys#process-wait pid nohang)
   (let* ([res (##core#inline "C_waitpid" pid (if nohang _wnohang 0))]
-         [norm (##core#inline "C_WIFEXITED" _wait-status)] )
-    (values
-      res
-      norm
-      (cond [norm (##core#inline "C_WEXITSTATUS" _wait-status)]
-            [(##core#inline "C_WIFSIGNALED" _wait-status)
-              (##core#inline "C_WTERMSIG" _wait-status)]
-            [else (##core#inline "C_WSTOPSIG" _wait-status)] ) ) ) )
+	 [norm (##core#inline "C_WIFEXITED" _wait-status)] )
+    (if (and (fx= res -1) (fx= _errno _eintr))
+	(##sys#dispatch-interrupt
+         (lambda () (##sys#process-wait pid nohang)))
+	(values
+	 res
+	 norm
+	 (cond [norm (##core#inline "C_WEXITSTATUS" _wait-status)]
+	       [(##core#inline "C_WIFSIGNALED" _wait-status)
+		(##core#inline "C_WTERMSIG" _wait-status)]
+	       [else (##core#inline "C_WSTOPSIG" _wait-status)] ) )) ) )
 
 (define parent-process-id (foreign-lambda int "C_getppid"))
 
diff --git a/tests/port-tests.scm b/tests/port-tests.scm
index 72d6861..81db14c 100644
--- a/tests/port-tests.scm
+++ b/tests/port-tests.scm
@@ -139,6 +139,27 @@ EOF
      (check (tcp-port-numbers in))
      (check (tcp-abandon-port in)))	; Not sure about abandon-port
 
+   
+   ;; This tests for two bugs which occurred on NetBSD and possibly
+   ;; other platforms, possibly due to multiprocessing:
+   ;; read-line with EINTR would loop endlessly and process-wait would
+   ;; signal a condition when interrupted rather than retrying.
+   (set-signal-handler! signal/chld void) ; Should be a noop but triggers EINTR
+   (receive (in out)
+     (create-pipe)
+     (receive (pid ok? status)
+       (process-wait
+        (process-fork
+         (lambda ()
+           (file-close in)              ; close receiving end
+           (with-output-to-port (open-output-file* out)
+             (lambda ()
+               (display "hello, world\n")
+               ;; exit prevents buffers from being discarded by implicit _exit
+               (exit 0))))))
+       (file-close out)                 ; close sending end
+       (assert (equal? '(#t 0 ("hello, world"))
+                       (list ok? status (read-lines (open-input-file* in)))))))
    )
   (else))
 
-- 
1.7.9.1