From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 15 Jul 2004 19:09:15 +0000 (+0000)
Subject: threads.xs doesn't check the return value of the thread creation
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d94006e83fb3a18ffb59fd5cb41bc7ab9d73a7f6;p=p5sagit%2Fp5-mst-13.2.git

threads.xs doesn't check the return value of the thread creation
call. D'oh! This gives SEGVs if the OS fails to create another thread.
Cause of problem located by Nigel Sandever

p4raw-id: //depot/perl@23120
---

diff --git a/ext/threads/threads.pm b/ext/threads/threads.pm
index a355f49..dcd2aa0 100755
--- a/ext/threads/threads.pm
+++ b/ext/threads/threads.pm
@@ -50,7 +50,7 @@ our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
 our @EXPORT = qw(
 async	
 );
-our $VERSION = '1.04';
+our $VERSION = '1.05';
 
 
 # || 0 to ensure compatibility with previous versions
@@ -139,7 +139,8 @@ it the other way around.
 
 This will create a new thread with the entry point function and give
 it LIST as parameters.  It will return the corresponding threads
-object. The new() method is an alias for create().
+object, or C<undef> if thread creation failed. The new() method is an
+alias for create().
 
 =item $thread->join
 
diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index e52143d..4148fb0 100755
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -381,6 +381,10 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
 
 	SV**            tmps_tmp = PL_tmps_stack;
 	I32             tmps_ix  = PL_tmps_ix;
+#ifndef WIN32
+	int		failure;
+	const char*	panic = NULL;
+#endif
 
 
 	MUTEX_LOCK(&create_destruct_mutex);
@@ -480,10 +484,8 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
 	/* Start the thread */
 
 #ifdef WIN32
-
 	thread->handle = CreateThread(NULL, 0, Perl_ithread_run,
 			(LPVOID)thread, 0, &thread->thr);
-
 #else
 	{
 	  static pthread_attr_t attr;
@@ -498,20 +500,40 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
 #  endif
 #  ifdef THREAD_CREATE_NEEDS_STACK
 	    if(pthread_attr_setstacksize(&attr, THREAD_CREATE_NEEDS_STACK))
-	      Perl_croak(aTHX_ "panic: pthread_attr_setstacksize failed");
+	      panic = "panic: pthread_attr_setstacksize failed";
 #  endif
 
 #ifdef OLD_PTHREADS_API
-	  pthread_create( &thread->thr, attr, Perl_ithread_run, (void *)thread);
+	    failure
+	      = panic ? 1 : pthread_create( &thread->thr, attr,
+					    Perl_ithread_run, (void *)thread);
 #else
 #  if defined(HAS_PTHREAD_ATTR_SETSCOPE) && defined(PTHREAD_SCOPE_SYSTEM)
 	  pthread_attr_setscope( &attr, PTHREAD_SCOPE_SYSTEM );
 #  endif
-	  pthread_create( &thread->thr, &attr, Perl_ithread_run, (void *)thread);
+	  failure
+	    = panic ? 1 : pthread_create( &thread->thr, &attr,
+					  Perl_ithread_run, (void *)thread);
 #endif
 	}
 #endif
 	known_threads++;
+	if (
+#ifdef WIN32
+	    thread->handle == NULL
+#else
+	    failure
+#endif
+	    ) {
+	  MUTEX_UNLOCK(&create_destruct_mutex);
+	  sv_2mortal(params);
+	  Perl_ithread_destruct(aTHX_ thread, "create failed");
+#ifndef WIN32
+	  if (panic)
+	    Perl_croak(aTHX_ panic);
+#endif
+	  return &PL_sv_undef;
+	}
 	active_threads++;
 	MUTEX_UNLOCK(&create_destruct_mutex);
 	sv_2mortal(params);