From: Artur Bergman <sky@nanisky.com>
Date: Fri, 3 Jan 2003 18:16:46 +0000 (+0000)
Subject: Fake what context we are running in for CLONE and DESTROY so
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1d784c9012710943ee8845da67010090b81b0eda;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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);