From 2154897990ddd05db5d4577f9e94f1d96e2cbca6 Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sun, 27 Mar 2016 17:11:53 +0200
Subject: [PATCH] Automatically retry file-close on _eintr.

Before, it would just raise an exception, causing lost file descriptors.
Thanks to Joerg Wittenberger.

Conflicts:
	posixunix.scm
	posixwin.scm
---
 NEWS          | 2 ++
 posixunix.scm | 8 ++++++--
 posixwin.scm  | 9 ++++++---
 3 files changed, 14 insertions(+), 5 deletions(-)

diff --git a/NEWS b/NEWS
index c5cd6bf..238b003 100644
--- a/NEWS
+++ b/NEWS
@@ -75,6 +75,8 @@
     file-type and all procedures using file-type. These are:
     regular-file?, symbolic-link?, block-device?, character-device?
     fifo? and socket?.
+  - Unit "posix": When "file-close" is interrupted it will retry,
+    to avoid leaking descriptors (thanks to Joerg Wittenberger).
   - Unit "data-structures": alist-{update[!],ref} were made consistent
     with srfi-1 in the argument order of comparison procedures.
   - Unit "lolevel": locative-ref has been fixed for locatives of u32
diff --git a/posixunix.scm b/posixunix.scm
index 362e40f..2cee32a 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -567,8 +567,12 @@ EOF
 (define file-close
   (lambda (fd)
     (##sys#check-fixnum fd 'file-close)
-    (when (fx< (##core#inline "C_close" fd) 0)
-      (posix-error #:file-error 'file-close "cannot close file" fd) ) ) )
+    (let loop ()
+      (when (fx< (##core#inline "C_close" fd) 0)
+	(select _errno
+	  ((_eintr) (##sys#dispatch-interrupt loop))
+	  (else
+	   (posix-error #:file-error 'file-close "cannot close file" fd))) ) ) ) )
 
 (define file-read
   (lambda (fd size . buffer)
diff --git a/posixwin.scm b/posixwin.scm
index ef95d03..fe50783 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -797,9 +797,12 @@ EOF
 (define file-close
   (lambda (fd)
     (##sys#check-fixnum fd 'file-close)
-    (when (fx< (##core#inline "C_close" fd) 0)
-      (##sys#update-errno)
-      (##sys#signal-hook #:file-error 'file-close "cannot close file" fd) ) ) )
+    (let loop ()
+      (when (fx< (##core#inline "C_close" fd) 0)
+	(select _errno
+	  ((_eintr) (##sys#dispatch-interrupt loop))
+	  (else
+	   (posix-error #:file-error 'file-close "cannot close file" fd))) ) ) ) )
 
 (define file-read
   (lambda (fd size . buffer)
-- 
2.1.4