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.
