Integrate mainline

p4raw-id: //depot/perlio@14690
p4raw-branched: from //depot/perl@14685 'branch in' ext/threads/t/end.t
	lib/Tie/Memoize.pm lib/Tie/Memoize.t
p4raw-integrated: from //depot/perl@14685 'copy in' lib/Tie/Hash.pm
	(@11169..) t/op/groups.t (@13598..) pod/perltie.pod (@13837..)
	ext/threads/threads.pm (@14416..) Makefile.SH (@14641..)
	Changes patchlevel.h (@14647..) lib/ExtUtils/Installed.pm
	(@14655..) lib/File/Spec/t/rel2abs2rel.t (@14656..) utf8.c
	(@14669..) MANIFEST (@14675..) ext/threads/threads.xs
	(@14678..) lib/ExtUtils/t/Installed.t (@14680..)

2 files changed, 58 insertions, 10 deletions

diff --git a/ext/threads/t/end.t b/ext/threads/t/end.t
new file mode 100644
index 0000000000..199ca4771a
--- /dev/null
+++ b/ext/threads/t/end.t
@@ -0,0 +1,41 @@
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    unless ($Config{'useithreads'}) {
+        print "1..0 # Skip: no useithreads\n";
+        exit 0;
+    }
+}
+
+use ExtUtils::testlib;
+use strict;
+BEGIN { print "1..6\n" };
+use threads;
+use threads::shared;
+
+my $test_id = 1;
+share($test_id);
+use Devel::Peek qw(Dump);
+
+sub ok {
+    my ($ok, $name) = @_;
+
+    # You have to do it this way or VMS will get confused.
+    print $ok ? "ok $test_id - $name\n" : "not ok $test_id - $name\n";
+
+    printf "# Failed test at line %d\n", (caller)[2] unless $ok;
+    $test_id++;
+    return $ok;
+}
+ok(1);
+END { ok(1,"End block run once") }
+threads->create(sub { eval "END { ok(1,'') }"})->join();
+threads->create(sub { eval "END { ok(1,'') }"})->join();
+threads->create(\&thread)->join();
+
+sub thread {
+	eval "END { ok(1,'') }";
+	threads->create(sub { eval "END { ok(1,'') }"})->join();
+}
diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 83dca93257..006e55252c 100755
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -69,10 +69,10 @@ ithread *threads;
 #define ithread_detach(thread)		Perl_ithread_detach(aTHX_ thread)
 #define ithread_tid(thread)		((thread)->tid)
 
-static perl_mutex create_mutex;  /* protects the creation of threads ??? */
+static perl_mutex create_destruct_mutex;  /* protects the creation and destruction of threads*/
 
 I32 tid_counter = 0;
-
+I32 active_threads = 0;
 perl_key self_key;
 
 /*
@@ -86,7 +86,7 @@ Perl_ithread_destruct (pTHX_ ithread* thread)
 		MUTEX_UNLOCK(&thread->mutex);
 		return;
 	}
-	MUTEX_LOCK(&create_mutex);
+	MUTEX_LOCK(&create_destruct_mutex);
 	/* Remove from circular list of threads */
 	if (thread->next == thread) {
 	    /* last one should never get here ? */
@@ -99,7 +99,8 @@ Perl_ithread_destruct (pTHX_ ithread* thread)
 		threads = thread->next;
 	    }
 	}
-	MUTEX_UNLOCK(&create_mutex);
+	active_threads--;
+	MUTEX_UNLOCK(&create_destruct_mutex);
 	/* Thread is now disowned */
 #if 0
         Perl_warn(aTHX_ "destruct %d @ %p by %p",
@@ -282,7 +283,7 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
 	ithread*	thread;
 	CLONE_PARAMS	clone_param;
 
-	MUTEX_LOCK(&create_mutex);
+	MUTEX_LOCK(&create_destruct_mutex);
 	thread = PerlMemShared_malloc(sizeof(ithread));
 	Zero(thread,1,ithread);
 	thread->next = threads;
@@ -315,7 +316,11 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
 	 */
 	{
 	    dTHXa(thread->interp);
-
+            /* Here we remove END blocks since they should only run
+	       in the thread they are created 
+            */
+            SvREFCNT_dec(PL_endav);
+            PL_endav = newAV();
             clone_param.flags = 0;
 	    thread->init_function = sv_dup(init_function, &clone_param);
 	    if (SvREFCNT(thread->init_function) == 0) {
@@ -363,7 +368,8 @@ Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* param
 #endif
 	}
 #endif
-	MUTEX_UNLOCK(&create_mutex);
+	active_threads++;
+	MUTEX_UNLOCK(&create_destruct_mutex);
 	return ithread_to_SV(aTHX_ obj, thread, classname, FALSE);
 }
 
@@ -526,8 +532,8 @@ BOOT:
 	ithread* thread;
 	PL_perl_destruct_level = 2;
 	PERL_THREAD_ALLOC_SPECIFIC(self_key);
-	MUTEX_INIT(&create_mutex);
-	MUTEX_LOCK(&create_mutex);
+	MUTEX_INIT(&create_destruct_mutex);
+	MUTEX_LOCK(&create_destruct_mutex);
 	thread  = PerlMemShared_malloc(sizeof(ithread));
 	Zero(thread,1,ithread);
 	PL_perl_destruct_level = 2;
@@ -538,6 +544,7 @@ BOOT:
 	thread->interp = aTHX;
 	thread->count  = 1;  /* imortal */
 	thread->tid = tid_counter++;
+	active_threads++;
 	thread->detached = 1;
 #ifdef WIN32
 	thread->thr = GetCurrentThreadId();
@@ -545,6 +552,6 @@ BOOT:
 	thread->thr = pthread_self();
 #endif
 	PERL_THREAD_SETSPECIFIC(self_key,thread);
-	MUTEX_UNLOCK(&create_mutex);
+	MUTEX_UNLOCK(&create_destruct_mutex);
 }