signal an error on multithreaded fork

* libguile/posix.c (scm_fork): Signal an error if a `fork' is attempted
  after threads have been spawned.

* test-suite/tests/00-socket.test: Moved here, from socket.test, so as
  to run before any threads are created.
* test-suite/Makefile.am: Adapt.

libguile/posix.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -1248,6 +1248,18 @@ SCM_DEFINE (scm_fork, "primitive-fork", 0, 0, 0,
 #define FUNC_NAME s_scm_fork
 {
   int pid;
+  if (scm_ilength (scm_all_threads ()) != 1)
+    /* Other threads may be holding on to resources that Guile needs --
+       it is not safe to permit one thread to fork while others are
+       running.
+
+       In addition, POSIX clearly specifies that if a multi-threaded
+       program forks, the child must only call functions that are
+       async-signal-safe.  We can't guarantee that in general.  The best
+       we can do is to allow forking only very early, before any call to
+       sigaction spawns the signal-handling thread.  */
+    SCM_MISC_ERROR ("attempt to fork while multiple threads are running",
+                    SCM_EOL);
   pid = fork ();
   if (pid == -1)
     SCM_SYSERROR;

test-suite/Makefile.am

@@ -1,7 +1,7 @@
 ## Process this file with automake to produce Makefile.in.
 ##
 ## Copyright 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
-##   2010, 2011 Software Foundation, Inc.
+##   2010, 2011, 2012 Software Foundation, Inc.
 ##
 ## This file is part of GUILE.
 ##
@@ -23,6 +23,7 @@
 SUBDIRS = standalone vm
 
 SCM_TESTS = tests/00-initial-env.test		\
+	    tests/00-socket.test		\
             tests/alist.test			\
 	    tests/and-let-star.test		\
 	    tests/arbiters.test			\
@@ -111,7 +112,6 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/regexp.test			\
 	    tests/session.test			\
 	    tests/signals.test			\
-	    tests/socket.test			\
 	    tests/srcprop.test			\
 	    tests/srfi-1.test			\
 	    tests/srfi-6.test			\

test-suite/tests/00-socket.test

@@ -1,7 +1,7 @@
-;;;; socket.test --- test socket functions     -*- scheme -*-
+;;;; 00-socket.test --- test socket functions     -*- scheme -*-
 ;;;;
 ;;;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010,
-;;;;   2011 Free Software Foundation, Inc.
+;;;;   2011, 2012 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -17,6 +17,9 @@
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
+;; This test runs early, so that we can fork before any threads are
+;; created in other tests.
+
 (define-module (test-suite test-socket)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-26)