From: Dave Mitchell <davem@fdisolutions.com>
Date: Thu, 8 Jan 2004 22:32:28 +0000 (+0000)
Subject: segv in pad.c with threads (was: DBD::Oracle and Perl 5.8.2 threads)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b23f1a86dd8a81ae1056d802240e99273db9cd3a;p=p5sagit%2Fp5-mst-13.2.git

segv in pad.c with threads (was: DBD::Oracle and Perl 5.8.2 threads)
Message-ID: <20040107121357.GD82921@dansat.data-plan.com>

Returning a closure from a thread (via join) could mess up because
pointers to PL_sv_undef weren't rejigged to point at the joiner's
version of PL_sv_undef. Also, the closure's CvGV got cloned too
but never freed, since CvGV isn't refcounted.

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

diff --git a/ext/threads/t/problems.t b/ext/threads/t/problems.t
index b2b78df..81e1825 100644
--- a/ext/threads/t/problems.t
+++ b/ext/threads/t/problems.t
@@ -18,7 +18,7 @@ use threads::shared;
 # call is() from within the DESTROY() function at global destruction time,
 # and parts of Test::* may have already been freed by then
 
-print "1..8\n";
+print "1..9\n";
 
 my $test : shared = 1;
 
@@ -93,4 +93,17 @@ threads->new(
     }
 )->join;
 
+# Returing a closure from a thread caused problems. If the last index in
+# the anon sub's pad wasn't for a lexical, then a core dump could occur.
+# Otherwise, there might be leaked scalars.
+
+sub f {
+    my $x = "foo";
+    sub { $x."bar" };
+}
+
+my $string = threads->new(\&f)->join->();
+print $string eq 'foobar' ?  '' : 'not ', "ok $test - returning closure\n";
+$test++;
+
 1;
diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index ba3e488..48530fe 100755
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -572,12 +572,17 @@ Perl_ithread_join(pTHX_ SV *obj)
 	{
 	  ithread*        current_thread;
 	  AV* params = (AV*) SvRV(thread->params);	
+	  PerlInterpreter *other_perl = thread->interp;
 	  CLONE_PARAMS clone_params;
 	  clone_params.stashes = newAV();
 	  clone_params.flags |= CLONEf_JOIN_IN;
 	  PL_ptr_table = ptr_table_new();
 	  current_thread = Perl_ithread_get(aTHX);
 	  Perl_ithread_set(aTHX_ thread);
+	  /* ensure 'meaningful' addresses retain their meaning */
+	  ptr_table_store(PL_ptr_table, &other_perl->Isv_undef, &PL_sv_undef);
+	  ptr_table_store(PL_ptr_table, &other_perl->Isv_no, &PL_sv_no);
+	  ptr_table_store(PL_ptr_table, &other_perl->Isv_yes, &PL_sv_yes);
 
 #if 0
 	  {
diff --git a/sv.c b/sv.c
index 5efd546..995be32 100644
--- a/sv.c
+++ b/sv.c
@@ -10374,7 +10374,10 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
                 SvREFCNT_inc(CvXSUBANY(sstr).any_ptr) :
                 sv_dup_inc(CvXSUBANY(sstr).any_ptr, param);
 	}
-	CvGV(dstr)	= gv_dup(CvGV(sstr), param);
+	/* don't dup if copying back - CvGV isn't refcounted, so the
+	 * duped GV may never be freed. A bit of a hack! DAPM */
+	CvGV(dstr)	= (param->flags & CLONEf_JOIN_IN) ?
+		Nullgv : gv_dup(CvGV(sstr), param) ;
 	if (param->flags & CLONEf_COPY_STACKS) {
 	  CvDEPTH(dstr)	= CvDEPTH(sstr);
 	} else {