~ chicken-core (chicken-5) 4720659fd58b4bfe2026616af9912d60ee9874b4

commit 4720659fd58b4bfe2026616af9912d60ee9874b4
Author:     Jörg F. Wittenberger <Joerg.Wittenberger@softeyes.net>
AuthorDate: Wed Feb 1 19:46:38 2017 +0100
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Fri Mar 10 10:30:35 2017 +1300

    Handle possible EINTR in file-lock, file-lock/blocking and file-unlock.
    
    Signed-off-by: Peter Bex <peter@more-magic.net>
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/NEWS b/NEWS
index 7cbe20dc..46636a93 100644
--- a/NEWS
+++ b/NEWS
@@ -58,6 +58,14 @@
   - Removed support for (define-syntax (foo e r c) ...), which was
     undocumented and not officially supported anyway.
 
+
+4.12.1
+
+- Core Libraries
+  - Unit "posix": If file-lock, file-lock/blocking or file-unlock are
+    interrupted by a signal, we now retry (thanks to Joerg Wittenberger).
+
+
 4.12.0
 
 - Security fixes
diff --git a/posixunix.scm b/posixunix.scm
index 7e9a21da..dee77c37 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -1242,16 +1242,22 @@ EOF
     (posix-error #:file-error loc msg (##sys#slot lock 1) (##sys#slot lock 2) (##sys#slot lock 3)) )
   (set! file-lock
     (lambda (port . args)
-      (let ([lock (setup port args 'file-lock)])
-        (if (fx< (##core#inline "C_flock_lock" port) 0)
-            (err "cannot lock file" lock 'file-lock)
-            lock) ) ) )
+      (let loop ()
+	(let ((lock (setup port args 'file-lock)))
+	  (if (fx< (##core#inline "C_flock_lock" port) 0)
+	      (select _errno
+		((_eintr) (##sys#dispatch-interrupt loop))
+		(else (err "cannot lock file" lock 'file-lock)))
+	      lock)))))
   (set! file-lock/blocking
     (lambda (port . args)
-      (let ([lock (setup port args 'file-lock/blocking)])
-        (if (fx< (##core#inline "C_flock_lockw" port) 0)
-            (err "cannot lock file" lock 'file-lock/blocking)
-            lock) ) ) )
+      (let loop ()
+	(let ((lock (setup port args 'file-lock/blocking)))
+	  (if (fx< (##core#inline "C_flock_lockw" port) 0)
+	      (select _errno
+		((_eintr) (##sys#dispatch-interrupt loop))
+		(else (err "cannot lock file" lock 'file-lock/blocking)))
+	      lock)))))
   (set! file-test-lock
     (lambda (port . args)
       (let ([lock (setup port args 'file-test-lock)])
@@ -1263,7 +1269,9 @@ EOF
     (##sys#check-structure lock 'lock 'file-unlock)
     (##core#inline "C_flock_setup" _f_unlck (##sys#slot lock 2) (##sys#slot lock 3))
     (when (fx< (##core#inline "C_flock_lock" (##sys#slot lock 1)) 0)
-      (posix-error #:file-error 'file-unlock "cannot unlock file" lock) ) ) )
+      (select _errno
+	((_eintr) (##sys#dispatch-interrupt (lambda () (file-unlock lock))))
+	(else (posix-error #:file-error 'file-unlock "cannot unlock file" lock))))))
 
 
 ;;; FIFOs: