From: Artur Bergman <sky@nanisky.com>
Date: Mon, 29 Oct 2001 12:56:12 +0000 (+0000)
Subject: Ugly fix to not die when a thread creator is holding locks.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cd8c9bf8e75f7ca1681db747e53988762aec8fa2;p=p5sagit%2Fp5-mst-13.2.git

Ugly fix to not die when a thread creator is holding locks.

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

diff --git a/ext/threads/shared/shared.pm b/ext/threads/shared/shared.pm
index 5607186..10d2af9 100644
--- a/ext/threads/shared/shared.pm
+++ b/ext/threads/shared/shared.pm
@@ -59,7 +59,7 @@ sub CLONE {
     return unless($_[0] eq "threads::shared");
 	foreach my $ptr (keys %shared) {
 	    if($ptr) {
-		thrcnt_inc($shared{$ptr});
+		thrcnt_inc($shared{$ptr},$threads::origthread);
 	    }
 	}
 }
diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs
index c00cf15..2eb2e6c 100644
--- a/ext/threads/shared/shared.xs
+++ b/ext/threads/shared/shared.xs
@@ -171,16 +171,21 @@ _thrcnt(ref)
 
 
 void
-thrcnt_inc(ref)
+thrcnt_inc(ref,perl)
         SV* ref
+	SV* perl
         CODE:
 	shared_sv* shared;
+	PerlInterpreter* origperl = (PerlInterpreter*) SvIV(perl);
+	PerlInterpreter* oldperl = PERL_GET_CONTEXT;
         if(SvROK(ref)) 
             ref = SvRV(ref);
         shared = Perl_sharedsv_find(aTHX, ref);
         if(!shared)
            croak("thrcnt can only be used on shared values");
+	PERL_SET_CONTEXT(origperl);
 	Perl_sharedsv_thrcnt_inc(aTHX_ shared);
+	PERL_SET_CONTEXT(oldperl);	
 
 void
 _thrcnt_dec(ref)
diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index a4e22ec..75a6b0b 100755
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -111,6 +111,11 @@ SV* Perl_thread_create(char* class, SV* init_function, SV* params) {
 	init_function = NULL;
 	temp_store = NULL;
 
+	temp_store = Perl_get_sv(current_perl, "threads::origthread", TRUE | GV_ADDMULTI);
+	sv_setiv(temp_store,(IV)current_perl);
+	temp_store = NULL;	
+
+	
 #ifdef WIN32
 	thread->interp = perl_clone(current_perl, 4);
 #else
@@ -122,6 +127,8 @@ SV* Perl_thread_create(char* class, SV* init_function, SV* params) {
 	thread->params = newSVsv(Perl_get_sv(thread->interp,
 					     "threads::paramtempstore",FALSE));
 
+
+
 	/*
 	 * And here we make sure we clean up the data we put in the
 	 * namespace of iThread, both in the new and the calling