Fake what context we are running in for CLONE and DESTROY so

threads->tid() returns the correct value.
This is reported as bug #10046

p4raw-id: //depot/perl@18417

diff --git a/ext/threads/t/basic.t b/ext/threads/t/basic.t
index fa9a655..4236bf6 100755 (executable)
--- a/ext/threads/t/basic.t
+++ b/ext/threads/t/basic.t
@@ -25,7 +25,7 @@ BEGIN {
 
 use ExtUtils::testlib;
 use strict;
-BEGIN { $| = 1; print "1..15\n" };
+BEGIN { $| = 1; print "1..19\n" };
 use threads;
 
 
@@ -116,6 +116,23 @@ threads->create('test8')->join;
 ok(14, 0 == threads->self->tid(),"Check so that tid for threads work for main thread");
 ok(15, 0 == threads->tid(),"Check so that tid for threads work for main thread");
 
+{
+    local *CLONE = sub { ok(16, threads->tid() == 9, "Tid should be correct in the clone")};
+    threads->create(sub { ok(17, threads->tid() == 9, "And tid be 9 here too") })->join();
+}
+
+{ 
+
+    sub Foo::DESTROY { 
+       ok(19, threads->tid() == 10, "In destroy it should be correct too" )
+       }
+    my $foo;
+    threads->create(sub { ok(18, threads->tid() == 10, "And tid be 10 here");
+                         $foo = bless {}, 'Foo';                         
+                         return undef;
+                     })->join();
+
+}
 1;
 
 

diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 5bcf4e4..87abad9 100755 (executable)
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -135,8 +135,13 @@ Perl_ithread_destruct (pTHX_ ithread* thread, const char *why)
        MUTEX_DESTROY(&thread->mutex);
         PerlMemShared_free(thread);
        if(destroyperl) {
+           ithread*        current_thread;
+           PERL_THREAD_GETSPECIFIC(self_key,current_thread);
+           PERL_THREAD_SETSPECIFIC(self_key,thread);
            perl_destruct(destroyperl);
             perl_free(destroyperl);
+           PERL_THREAD_SETSPECIFIC(self_key,current_thread);
+
        }
        PERL_SET_CONTEXT(aTHX);
 }
@@ -358,7 +363,8 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
 {
        ithread*        thread;
        CLONE_PARAMS    clone_param;
-
+       ithread*        current_thread;
+       PERL_THREAD_GETSPECIFIC(self_key,current_thread);
        MUTEX_LOCK(&create_destruct_mutex);
        thread = PerlMemShared_malloc(sizeof(ithread));
        Zero(thread,1,ithread);
@@ -379,7 +385,7 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
         */
 
        PerlIO_flush((PerlIO*)NULL);
-
+       PERL_THREAD_SETSPECIFIC(self_key,thread);
 #ifdef WIN32
        thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE | CLONEf_CLONE_HOST);
 #else
@@ -410,7 +416,7 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
            PL_ptr_table = NULL;
            PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
        }
-
+       PERL_THREAD_SETSPECIFIC(self_key,current_thread);
        PERL_SET_CONTEXT(aTHX);
 
        /* Start the thread */
@@ -507,11 +513,15 @@ Perl_ithread_join(pTHX_ SV *obj)
        
        /* sv_dup over the args */
        {
+         ithread*        current_thread;
          AV* params = (AV*) SvRV(thread->params);      
          CLONE_PARAMS clone_params;
          clone_params.stashes = newAV();
          PL_ptr_table = ptr_table_new();
+         PERL_THREAD_GETSPECIFIC(self_key,current_thread);
+         PERL_THREAD_SETSPECIFIC(self_key,thread);
          retparam = (AV*) sv_dup((SV*)params, &clone_params);
+         PERL_THREAD_SETSPECIFIC(self_key,current_thread);
          SvREFCNT_dec(clone_params.stashes);
          SvREFCNT_inc(retparam);
          ptr_table_free(PL_ptr_table);