Change 18424: Integrate:

Change 18424 by jhi@lyta on 2003/01/04 03:20:08

	Integrate:
	[ 18417]
	Fake what context we are running in for CLONE and DESTROY so 
	threads->tid() returns the correct value.
	This is reported as bug #10046
	
	[ 18419]
	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.
	
	[ 18421]
	Fix long standing memory leak with pop and shift!

Affected files ...

... //depot/maint-5.8/perl/MANIFEST#15 integrate
... //depot/maint-5.8/perl/ext/threads/shared/shared.xs#2 integrate
... //depot/maint-5.8/perl/ext/threads/t/basic.t#2 integrate
... //depot/maint-5.8/perl/ext/threads/threads.xs#3 integrate
... //depot/maint-5.8/perl/sv.c#17 integrate
... //depot/maint-5.8/perl/sv.h#5 integrate

Differences ...

==== //depot/maint-5.8/perl/MANIFEST#15 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#14~18379~	Tue Dec 31 07:33:11 2002
+++ perl/MANIFEST	Fri Jan  3 19:20:08 2003
@@ -701,6 +701,7 @@
 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.

==== //depot/maint-5.8/perl/ext/threads/shared/shared.xs#2 (text) ====
Index: perl/ext/threads/shared/shared.xs
--- perl/ext/threads/shared/shared.xs#1~17645~	Fri Jul 19 12:29:57 2002
+++ perl/ext/threads/shared/shared.xs	Fri Jan  3 19:20:08 2003
@@ -813,8 +813,9 @@
 	SHARED_CONTEXT;
 	sv = av_pop((AV*)SHAREDSvPTR(shared));
 	CALLER_CONTEXT;
-	ST(0) = Nullsv;
+	ST(0) = sv_newmortal();
 	Perl_sharedsv_associate(aTHX_ &ST(0), sv, 0);
+	SvREFCNT_dec(sv);
 	LEAVE_LOCK;
 	XSRETURN(1);
 
@@ -827,8 +828,9 @@
 	SHARED_CONTEXT;
 	sv = av_shift((AV*)SHAREDSvPTR(shared));
 	CALLER_CONTEXT;
-	ST(0) = Nullsv;
+	ST(0) = sv_newmortal();
 	Perl_sharedsv_associate(aTHX_ &ST(0), sv, 0);
+	SvREFCNT_dec(sv);
 	LEAVE_LOCK;
 	XSRETURN(1);
 

==== //depot/maint-5.8/perl/ext/threads/t/basic.t#2 (xtext) ====
Index: perl/ext/threads/t/basic.t
--- perl/ext/threads/t/basic.t#1~17645~	Fri Jul 19 12:29:57 2002
+++ perl/ext/threads/t/basic.t	Fri Jan  3 19:20:08 2003
@@ -25,7 +25,7 @@
 
 use ExtUtils::testlib;
 use strict;
-BEGIN { $| = 1; print "1..15\n" };
+BEGIN { $| = 1; print "1..19\n" };
 use threads;
 
 
@@ -116,6 +116,23 @@
 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;
 
 

==== //depot/maint-5.8/perl/ext/threads/threads.xs#3 (xtext) ====
Index: perl/ext/threads/threads.xs
--- perl/ext/threads/threads.xs#2~18173~	Fri Nov 22 18:02:33 2002
+++ perl/ext/threads/threads.xs	Fri Jan  3 19:20:08 2003
@@ -135,8 +135,13 @@
 	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);
 }
@@ -277,12 +282,12 @@
 		}
 		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);
 		}
@@ -358,7 +363,8 @@
 {
 	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 @@
 	 */
 
 	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 @@
 	    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,32 @@
 	
 	/* sv_dup over the args */
 	{
+	  ithread*        current_thread;
 	  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);
 	  ptr_table_free(PL_ptr_table);

==== //depot/maint-5.8/perl/sv.c#17 (text) ====
Index: perl/sv.c
--- perl/sv.c#16~18414~	Fri Jan  3 08:39:33 2003
+++ perl/sv.c	Fri Jan  3 19:20:08 2003
@@ -9407,6 +9407,18 @@
     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);

==== //depot/maint-5.8/perl/sv.h#5 (text) ====
Index: perl/sv.h
--- perl/sv.h#4~18387~	Wed Jan  1 17:39:31 2003
+++ perl/sv.h	Fri Jan  3 19:20:08 2003
@@ -1203,6 +1203,7 @@
 #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;
End of Patch.

• Change 18424: Integrate: by Jarkko Hietaniemi