~ chicken-core (chicken-5) 3ba1326e6f9b3aa2062fa032a7c218e60f32e8b2

commit 3ba1326e6f9b3aa2062fa032a7c218e60f32e8b2
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Sun Mar 27 16:10:13 2016 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Sun Mar 27 16:10:13 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 40fbf7bb..39334649 100644
--- a/NEWS
+++ b/NEWS
@@ -43,6 +43,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 f56960dd..ede68772 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -514,8 +514,12 @@ EOF
 (define file-close
   (lambda (fd)
     (##sys#check-exact 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 81d2af23..2f46aaff 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -743,9 +743,12 @@ EOF
 (define file-close
   (lambda (fd)
     (##sys#check-exact 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)