From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Tue, 19 Oct 2010 17:00:51 +0000 (+0000)
Subject: 1.0.43.76: sb-posix: prohibit forking with multiple threads running everywhere
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=db12bb28ea6cb11b0335f94c6ef7438e7e184ab3;p=sbcl.git

1.0.43.76: sb-posix: prohibit forking with multiple threads running everywhere

 Turns out we were only checking this on Darwin.
---

diff --git a/NEWS b/NEWS
index 6d636a4..8b642ed 100644
--- a/NEWS
+++ b/NEWS
@@ -81,6 +81,9 @@ changes relative to sbcl-1.0.43:
   * bug fix: (COERCE X '(SIMPLE-VECTOR 5)) and similar coercions to vectors
     of specified length could confuse the type derivation in unsafe code.
     (lp#655872)
+  * bug fix: SB-POSIX:FORK now signals an error if an attempt to
+    fork with multiple Lisp threads running is made on every platform,
+    not just Darwin. (lp#451111)
 
 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/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp
index 9d248dd..5c8a877 100644
--- a/contrib/sb-posix/interface.lisp
+++ b/contrib/sb-posix/interface.lisp
@@ -283,27 +283,27 @@
 
 
 
+  ;; FIXME this is a lie, of course this can fail, but there's no
+  ;; error handling here yet!
   #+mach-exception-handler
-  (progn
-    ;; FIXME this is a lie, of course this can fail, but there's no
-    ;; error handling here yet!
-    (define-call "setup_mach_exceptions" void never-fails)
-    (define-call ("posix_fork" :c-name "fork") pid-t minusp)
-    (defun fork ()
-      (tagbody
-         (sb-thread::with-all-threads-lock
-           (when (cdr sb-thread::*all-threads*)
-             (go :error))
-           (let ((pid (posix-fork)))
-             (when (= pid 0)
-               (setup-mach-exceptions))
-             (return-from fork pid)))
-       :error
-         (error "Cannot fork with multiple threads running.")))
-    (export 'fork :sb-posix))
-
-  #-mach-exception-handler
-  (define-call "fork" pid-t minusp)
+  (define-call "setup_mach_exceptions" void never-fails)
+  (define-call ("posix_fork" :c-name "fork") pid-t minusp)
+  (defun fork ()
+    "Forks the current process, returning 0 in the new process and the PID of
+the child process in the parent. Forking while multiple threads are running is
+not supported."
+    (tagbody
+       (sb-thread::with-all-threads-lock
+         (when (cdr sb-thread::*all-threads*)
+           (go :error))
+         (let ((pid (posix-fork)))
+           #+mach-exception-handler
+           (when (= pid 0)
+             (setup-mach-exceptions))
+           (return-from fork pid)))
+     :error
+       (error "Cannot fork with multiple threads running.")))
+  (export 'fork :sb-posix)
 
   (define-call "getpgid" pid-t minusp (pid pid-t))
   (define-call "getppid" pid-t never-fails)
diff --git a/version.lisp-expr b/version.lisp-expr
index 1cfd126..832c68e 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.75"
+"1.0.43.76"