This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate:
authorNicholas Clark <nick@ccl4.org>
Sat, 17 Jul 2004 09:36:41 +0000 (09:36 +0000)
committerNicholas Clark <nick@ccl4.org>
Sat, 17 Jul 2004 09:36:41 +0000 (09:36 +0000)
[ 23120]
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-link: @23120 on //depot/perl: d94006e83fb3a18ffb59fd5cb41bc7ab9d73a7f6

p4raw-id: //depot/maint-5.8/perl@23133
p4raw-integrated: from //depot/perl@23132 'copy in'
ext/threads/threads.pm (@23019..)
p4raw-integrated: from //depot/perl@23120 'copy in'
ext/threads/threads.xs (@22918..)

ext/threads/threads.pm
ext/threads/threads.xs

index a355f49..dcd2aa0 100755 (executable)
@@ -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
 
index e52143d..4148fb0 100755 (executable)
@@ -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);