From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Thu, 30 Sep 2010 07:38:07 +0000 (+0000)
Subject: 1.0.43.4: deal with interrupted open(2) calls
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=800666c9dd66dd953c648b98fdcb340d68510175;p=sbcl.git

1.0.43.4: deal with interrupted open(2) calls

 Particularly if the other end is a FIFO, it isn't all that
 hard to get interrupted before open() completes.
---

diff --git a/NEWS b/NEWS
index 3a669e3..fc54907 100644
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,7 @@ changes relative to sbcl-1.0.43:
     (AND VECTOR (NOT SIMPLE-ARRAY)) when appropriate. (lp#309130)
   * bug fix: (THE (VALUES ...)) in LOAD-TIME-VALUE caused a compiler-error.
     (lp#646796)
+  * bug fix: interrupts arriving due to CL:OPEN caused an error.
 
 changes in sbcl-1.0.43 relative to sbcl-1.0.42:
   * incompatible change: FD-STREAMS no longer participate in the serve-event
diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 7bb9929..ae5875f 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -156,12 +156,13 @@ corresponds to NAME, or NIL if there is none."
   (declare (type unix-pathname path)
            (type fixnum flags)
            (type unix-file-mode mode))
-  (int-syscall ("open" c-string int int)
-               path
-               (logior #!+win32 o_binary
-                       #!+largefile o_largefile
-                       flags)
-               mode))
+  (with-restarted-syscall (value errno)
+    (int-syscall ("open" c-string int int)
+                 path
+                 (logior #!+win32 o_binary
+                         #!+largefile o_largefile
+                         flags)
+                 mode)))
 
 ;;; UNIX-CLOSE accepts a file descriptor and attempts to close the file
 ;;; associated with it.
diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp
index adf3986..955bd97 100644
--- a/tests/stream.impure.lisp
+++ b/tests/stream.impure.lisp
@@ -607,4 +607,36 @@
       (read-char-no-hang stream)
       (assert (< (- (get-universal-time) time) 2)))))
 
+#-win32
+(require :sb-posix)
+
+#-win32
+(with-test (:name :interrupt-open)
+  (let ((fifo nil)
+        (to 0))
+    (unwind-protect
+         (progn
+           ;; Make a FIFO
+           (setf fifo (sb-posix:mktemp "SBCL-fifo.XXXXXXX"))
+           (sb-posix:mkfifo fifo (logior sb-posix:s-iwusr sb-posix:s-irusr))
+           ;; Try to open it (which hangs), and interrupt ourselves with a timer,
+           ;; continue (this used to result in an error due to open(2) returning with
+           ;; EINTR, then interupt again and unwind.
+           (handler-case
+               (with-timeout 2
+                 (handler-bind ((timeout (lambda (c)
+                                           (when (eql 1 (incf to))
+                                             (continue c)))))
+                   (with-timeout 1
+                     (with-open-file (f fifo :direction :input)
+                       :open))))
+             (timeout ()
+               (if (eql 2 to)
+                   :timeout
+                   :wtf))
+             (error (e)
+               e)))
+      (when fifo
+        (ignore-errors (delete-file fifo))))))
+
 ;;; success
diff --git a/version.lisp-expr b/version.lisp-expr
index 4b00ed2..81d2bac 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.43.3"
+"1.0.43.4"