~ chicken-core (chicken-5) 29ae9575759e9650547145d9f13ac73c9b0c336b

commit 29ae9575759e9650547145d9f13ac73c9b0c336b
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Sun Mar 27 17:11:53 2016 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Sun Mar 27 17:11:53 2016 +0200

    Automatically retry file-close on _eintr
    
    Before, it would just raise an exception, causing lost file descriptors.
    
    Thanks to Joerg Wittenberger.
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/NEWS b/NEWS
index f2a72ceb..5097499c 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 362e40f3..56bb246d 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 ef95d03a..061e2744 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)