From 0405e91e9230dfa76b6164c6ed64f7dab29ff49a Mon Sep 17 00:00:00 2001
From: Artur Bergman <sky@nanisky.com>
Date: Fri, 3 Jan 2003 23:45:34 +0000
Subject: [PATCH] Fixes bug #15273, the return of the object caused the stash
 of the object to be cloned, cloning the entire syntax tree and all lexicals
 in there creating danglning copies to the object. (Pararell but unlinked
 STASH tree). This adds a new flag, when set it will use STASHES from the
 thread we are joining into avoiding the problem.

p4raw-id: //depot/perl@18419
---
 MANIFEST               |  1 +
 ext/threads/threads.xs | 19 ++++++++++++++++++-
 sv.c                   | 12 ++++++++++++
 sv.h                   |  1 +
 4 files changed, 32 insertions(+), 1 deletion(-)

diff --git a/MANIFEST b/MANIFEST
index cb8ac8e..4e798d4 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -700,6 +700,7 @@ ext/threads/t/end.t		Test end functions
 ext/threads/t/join.t		Testing the join function
 ext/threads/t/libc.t		testing libc functions for threadsafety
 ext/threads/t/list.t		Test threads->list()
+ext/threads/t/problems.t	Test various memory problems
 ext/threads/t/stress_cv.t	Test with multiple threads, coderef cv argument.
 ext/threads/t/stress_re.t	Test with multiple threads, string cv argument and regexes.
 ext/threads/t/stress_string.t	Test with multiple threads, string cv argument.
diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index 87abad9..d95e748 100755
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -282,12 +282,12 @@ Perl_ithread_run(void * arg) {
 		}
 		PUTBACK;
 		len = call_sv(thread->init_function, thread->gimme|G_EVAL);
+
 		SPAGAIN;
 		for (i=len-1; i >= 0; i--) {
 		  SV *sv = POPs;
 		  av_store(params, i, SvREFCNT_inc(sv));
 		}
-		PUTBACK;
 		if (SvTRUE(ERRSV)) {
 		    Perl_warn(aTHX_ "thread failed to start: %" SVf, ERRSV);
 		}
@@ -517,10 +517,27 @@ Perl_ithread_join(pTHX_ SV *obj)
 	  AV* params = (AV*) SvRV(thread->params);	
 	  CLONE_PARAMS clone_params;
 	  clone_params.stashes = newAV();
+	  clone_params.flags |= CLONEf_JOIN_IN;
 	  PL_ptr_table = ptr_table_new();
 	  PERL_THREAD_GETSPECIFIC(self_key,current_thread);
 	  PERL_THREAD_SETSPECIFIC(self_key,thread);
+
+	  {
+	    I32 len = av_len(params)+1;
+	    I32 i;
+	    for(i = 0; i < len; i++) {
+	      //	      sv_dump(SvRV(AvARRAY(params)[i]));
+	    }
+	  }
+
 	  retparam = (AV*) sv_dup((SV*)params, &clone_params);
+	  {
+	    I32 len = av_len(retparam)+1;
+	    I32 i;
+	    for(i = 0; i < len; i++) {
+	      //sv_dump(SvRV(AvARRAY(retparam)[i]));
+	    }
+	  }
 	  PERL_THREAD_SETSPECIFIC(self_key,current_thread);
 	  SvREFCNT_dec(clone_params.stashes);
 	  SvREFCNT_inc(retparam);
diff --git a/sv.c b/sv.c
index e522a47..08eac58 100644
--- a/sv.c
+++ b/sv.c
@@ -9346,6 +9346,18 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
     if (dstr)
 	return dstr;
 
+    if(param->flags & CLONEf_JOIN_IN) {
+        /** We are joining here so we don't want do clone
+	    something that is bad **/
+
+        if(SvTYPE(sstr) == SVt_PVHV &&
+	   HvNAME(sstr)) {
+	    /** don't clone stashes if they already exist **/
+	    HV* old_stash = gv_stashpv(HvNAME(sstr),0);
+	    return (SV*) old_stash;
+        }
+    }
+
     /* create anew and remember what it is */
     new_SV(dstr);
     ptr_table_store(PL_ptr_table, sstr, dstr);
diff --git a/sv.h b/sv.h
index d87ba11..7c5e6dc 100644
--- a/sv.h
+++ b/sv.h
@@ -1186,6 +1186,7 @@ Returns a pointer to the character buffer.
 #define CLONEf_COPY_STACKS 1
 #define CLONEf_KEEP_PTR_TABLE 2
 #define CLONEf_CLONE_HOST 4
+#define CLONEf_JOIN_IN 8
 
 struct clone_params {
   AV* stashes;
-- 
2.7.4