problems with Scalar::Util::weaken() and CLONE under ithreads #6986
Comments
From stas@stason.orgScalar::Util::weaken() proposed to use in the conjunction with the CLONE Here is an example: #/tmp/weaken2 % perl-5.8.1-ithread /tmp/weaken2 Oops, a weakened $copy was cloned too, but its guts are now messed #/tmp/weaken use strict; use Scalar::Util; my %objects; $objects{"$self"} = $copy; sub DESTROY { sub CLONE { package main; my $obj = Foo->new; threads->new(sub { print "thread started\n";})->detach for (1..1); % perl-5.8.1-ithread /tmp/weaken As you can see SV 0x8156e28 is: SV = PVAV(0x8153494) at 0x8156e28 Any chance we can change perl to call Devel::Peek::Dump when producing: Attempt to free unreferenced scalar SV 0x8154f74. would save us a lot of time, trying to figure out what SV went lost. As Liz has pointed out: The problem with the weakened scalar does not exist in 5.8.0, but does exist perl-5.8.1-ithread -V Characteristics of this binary (from libperl): |
From enache@rdslink.roThe patch below apparently fixes the problems with sv_rvweaken and ithreads. The idea of "backreferences" is bogus in the first place: there are I'm not sure it's correct: however it's the only thing I found which Regards, Inline Patch--- /arc/bleadperl/sv.c 2003-12-12 01:22:45.000000000 +0200
+++ ./sv.c 2003-12-18 22:30:18.000000000 +0200
@@ -5137,15 +5137,13 @@ S_sv_add_backref(pTHX_ SV *tsv, SV *sv)
* by magic_killbackrefs() when tsv is being freed */
}
if (AvFILLp(av) >= AvMAX(av)) {
+ I32 i;
SV **svp = AvARRAY(av);
- I32 i = AvFILLp(av);
- while (i >= 0) {
- if (svp[i] == &PL_sv_undef) {
+ for (i = AvFILLp(av); i >= 0; i--)
+ if (!svp[i]) {
svp[i] = sv; /* reuse the slot */
return;
}
- i--;
- }
av_extend(av, AvFILLp(av)+1);
}
AvARRAY(av)[++AvFILLp(av)] = sv; /* av_push() */
@@ -5167,13 +5165,8 @@ S_sv_del_backref(pTHX_ SV *sv)
Perl_croak(aTHX_ "panic: del_backref");
av = (AV *)mg->mg_obj;
svp = AvARRAY(av);
- i = AvFILLp(av);
- while (i >= 0) {
- if (svp[i] == sv) {
- svp[i] = &PL_sv_undef; /* XXX */
- }
- i--;
- }
+ for (i = AvFILLp(av); i >= 0; i--)
+ if (svp[i] == sv) svp[i] = Nullsv;
}
/*
@@ -9793,16 +9786,15 @@ Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAM
nmg->mg_obj = (SV*)re_dup((REGEXP*)mg->mg_obj, param);
}
else if(mg->mg_type == PERL_MAGIC_backref) {
- AV *av = (AV*) mg->mg_obj;
- SV **svp;
- I32 i;
- nmg->mg_obj = (SV*)newAV();
- svp = AvARRAY(av);
- i = AvFILLp(av);
- while (i >= 0) {
- av_push((AV*)nmg->mg_obj,sv_dup(svp[i],param));
- i--;
- }
+ AV *av = (AV*) mg->mg_obj;
+ SV **svp;
+ I32 i;
+ SvREFCNT_inc(nmg->mg_obj = (SV*)newAV());
+ svp = AvARRAY(av);
+ for (i = AvFILLp(av); i >= 0; i--) {
+ if (!svp[i] || SvREFCNT(svp[i]) < 2) continue;
+ av_push((AV*)nmg->mg_obj,sv_dup(svp[i],param));
+ }
}
else {
nmg->mg_obj = (mg->mg_flags & MGf_REFCOUNTED)
--- /arc/bleadperl/mg.c 2003-12-15 11:33:01.000000000 +0200
+++ ./mg.c 2003-12-18 22:25:44.000000000 +0200
@@ -1927,14 +1927,14 @@ Perl_magic_killbackrefs(pTHX_ SV *sv, MA
SV **svp = AvARRAY(av);
I32 i = AvFILLp(av);
while (i >= 0) {
- if (svp[i] && svp[i] != &PL_sv_undef) {
+ if (svp[i]) {
if (!SvWEAKREF(svp[i]))
Perl_croak(aTHX_ "panic: magic_killbackrefs");
/* XXX Should we check that it hasn't changed? */
SvRV(svp[i]) = 0;
(void)SvOK_off(svp[i]);
SvWEAKREF_off(svp[i]);
- svp[i] = &PL_sv_undef;
+ svp[i] = Nullsv;
}
i--;
} |
From stas@stason.orgEnache Adrian wrote:
Thanks a lot, Enache!!! It indeed solves 2 cases in my report #24660 and 1 case in Liz's #24663, but make test You can get this test package from here: The problem seems to be in lib/Example/CLONE.pm: *CLONE = sub { my $self = $objects{$key}; the problem disappears. __________________________________________________________________ |
From enache@rdslink.roOn Thu, Dec 18, 2003 a.d., Stas Bekman wrote:
Hmm, I cannot reproduce that. $ make test I'll try with a non-DEBUGGING perl too ... Regards, |
From stas@stason.orgAdrian Enache via RT wrote:
Mine is DEBUGGING May be this will help: My blead is #21917 My perl -V: perl-blead-ithread -V Characteristics of this binary (from libperl): __________________________________________________________________ |
From enache@rdslink.roOn Thu, Dec 18, 2003 a.d., Stas Bekman wrote:
...
I suspect the perl you're using to build Example-CLONE is picking Without the patch, the tests barf as you describe; with the patch they Regards, |
From stas@stason.orgEnache Adrian wrote:
It can't pick the old library since it's been overwritten by the new one, I
But I know what's going on. I get these failures at random. So your must For example if I add 'sleep 1' to read_test, half of the test fails ... # workaround the situations where the main thread exits before the I hope you will be able to reproduce it. BTW, I have just a single processor. __________________________________________________________________ |
From enache@rdslink.roOn Thu, Dec 18, 2003 a.d., Stas Bekman wrote:
That's right. But that problem doesn't seem to be related to your use Regards, |
From stas@stason.orgAdrian Enache via RT wrote:
That means that you were able to reproduce it, right?
I thought it does, since it happens when you delete a weakened var. But I
I'm seeing a similar error when deleting a totally different thing from a hash __________________________________________________________________ |
From enache@rdslink.roOn Fri, Dec 19, 2003 a.d., Stas Bekman wrote:
Unfortunately, yes :-)
It looks worse: $ perl -mthreads -e 'threads->new(sub{my%h=(1,2);delete $h{1}})->join for 1,2'
Regards, |
From stas@stason.orgAdrian Enache via RT wrote:
Fun! And I have one more below. I'm not 100% if it's the same as yours.
I've got it reproduced. I thought it had something to do with XSUB, but a #/tmp/delete package main; % perl-blead-ithread /tmp/delete So it all has to do with cloned package hashes and calling 'delete' on its __________________________________________________________________ |
From stas@stason.orgAnd here is yet another example, this time with XSUB, which I think is a bit #-------------------- END { package main; If I do: my $orig_sub = delete $objects{$s}; I get: Attempt to free unreferenced scalar: If I do the same in two steps: my $orig_sub = $objects{$s}; everything is fine. __________________________________________________________________ |
From stas@stason.orgHad anybody have a chance to look at it? It causes very annoying error reports I've first reported this problem about 5 months ago. Stas Bekman (via RT) wrote:
-- |
From @smpeters
I'm no longer seeing this issue on perl-5.8.7. Is anyone able to |
From @iabynOn Sun, Oct 16, 2005 at 09:18:53AM -0700, Steve Peters via RT wrote:
Appears to have been fixed somewhere between 21874 and 21978 -- |
|
@smpeters - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#24660 (status was 'resolved')
Searchable as RT24660$
The text was updated successfully, but these errors were encountered: