Change 18419 by sky@sky-tibook on 2003/01/03 23:45:34
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.
Affected files ...
... //depot/perl/MANIFEST#960 edit
... //depot/perl/ext/threads/threads.xs#54 edit
... //depot/perl/sv.c#610 edit
... //depot/perl/sv.h#130 edit
Differences ...
==== //depot/perl/MANIFEST#960 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#959~18374~ Sun Dec 29 19:32:22 2002
+++ perl/MANIFEST Fri Jan 3 15:45:34 2003
@@ -700,6 +700,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/perl/ext/threads/threads.xs#54 (xtext) ====
Index: perl/ext/threads/threads.xs
--- perl/ext/threads/threads.xs#53~18417~ Fri Jan 3 10:16:46 2003
+++ perl/ext/threads/threads.xs Fri Jan 3 15:45:34 2003
@@ -282,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);
}
@@ -517,10 +517,27 @@
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);
==== //depot/perl/sv.c#610 (text) ====
Index: perl/sv.c
--- perl/sv.c#609~18407~ Fri Jan 3 02:30:05 2003
+++ perl/sv.c Fri Jan 3 15:45:34 2003
@@ -9346,6 +9346,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/perl/sv.h#130 (text) ====
Index: perl/sv.h
--- perl/sv.h#129~18410~ Fri Jan 3 03:06:40 2003
+++ perl/sv.h Fri Jan 3 15:45:34 2003
@@ -1186,6 +1186,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.
