The idea of "backreferences" is bogus in the first place: there are
probably still a lot of problems with it.
I'm not sure it's correct: however it's the only thing I found which
avoids all of loud and silent leaks, wrong reference counts, etc.
Regards,
Adi
--- /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--;
}
Thanks a lot, Enache!!!
It indeed solves 2 cases in my report #24660 and 1 case in Liz's #24663, but
the problem has not completely gone: Example::CLONE 'make test' still has this
problem:
make test
...
PERL_DL_NONLAZY=1 /home/stas/perl/blead-ithread/bin/perl5.9.0
"-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/basic......ok
t/threads....ok 9/17Attempt to free unreferenced scalar: SV 0x40179e5c at
/home/stas/work/modules/Example-CLONE/blib/lib/Example/CLONE.pm line 47.
t/threads....ok 13/17Attempt to free unreferenced scalar: SV 0x40179e5c at
/home/stas/work/modules/Example-CLONE/blib/lib/Example/CLONE.pm line 47.
t/threads....ok
All tests successful.
You can get this test package from here:
http://apache.org/~stas/Example-CLONE-0.01.tar.gz
The problem seems to be in lib/Example/CLONE.pm:
*CLONE = sub {
for my $key ( keys %objects) {
my $self = delete $objects{$key};
^^^^^^^^
If I rewrite the above code as:
my $self = $objects{$key};
delete $objects{$key};
the problem disappears.
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:st...@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
Hmm, I cannot reproduce that.
$ make test
...
PERL_DL_NONLAZY=1 /opt/y/perl/5.9.0/i686-linux-thread-multi-64int-ld/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/basic......ok
t/threads....ok
All tests successful.
Files=2, Tests=25, 1 wallclock secs ( 0.74 cusr + 0.12 csys = 0.86 CPU)
I'll try with a non-DEBUGGING perl too ...
Regards,
Adi
Mine is DEBUGGING
May be this will help:
My blead is #21917
My perl -V:
perl-blead-ithread -V
Summary of my perl5 (revision 5.0 version 9 subversion 0 patch 21917)
configuration:
Platform:
osname=linux, osvers=2.4.22-10mdk, archname=i686-linux-thread-multi
uname='linux rabbit.stason.org 2.4.22-10mdk #1 thu sep 18 12:30:58 cest
2003 i686 unknown unknown gnulinux '
config_args='-des -Dprefix=/home/stas/perl/blead-ithread -Dusethreads
-Doptimize=-g -Duseshrplib -Dusedevel'
hint=recommended, useposix=true, d_sigaction=define
usethreads=define useithreads=define usemultiplicity=define
useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
use64bitint=undef use64bitall=undef uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS
-DDEBUGGING -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE
-D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm',
optimize='-g',
cppflags='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBUGGING
-fno-strict-aliasing -I/usr/local/include -I/usr/include/gdbm'
ccversion='', gccversion='3.3.1 (Mandrake Linux 9.2 3.3.1-4mdk)',
gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=8
alignbytes=4, prototype=define
Linker and Libraries:
ld='cc', ldflags =' -L/usr/local/lib'
libpth=/usr/local/lib /lib /usr/lib
libs=-lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lpthread -lc
perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
libc=/lib/libc-2.3.2.so, so=so, useshrplib=true, libperl=libperl.so
gnulibc_version='2.3.2'
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic
-Wl,-rpath,/home/stas/perl/blead-ithread/lib/5.9.0/i686-linux-thread-multi/CORE'
cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'
Characteristics of this binary (from libperl):
Compile-time options: DEBUGGING MULTIPLICITY USE_ITHREADS USE_LARGE_FILES
PERL_IMPLICIT_CONTEXT
Locally applied patches:
DEVEL21538
Built under linux
Compiled at Dec 16 2003 11:20:18
%ENV:
PERLDOC_PAGER="less -R"
@INC:
/home/stas/perl/blead-ithread/lib/5.9.0/i686-linux-thread-multi
/home/stas/perl/blead-ithread/lib/5.9.0
/home/stas/perl/blead-ithread/lib/site_perl/5.9.0/i686-linux-thread-multi
/home/stas/perl/blead-ithread/lib/site_perl/5.9.0
/home/stas/perl/blead-ithread/lib/site_perl
I suspect the perl you're using to build Example-CLONE is picking
the old shared library.
Without the patch, the tests barf as you describe; with the patch they
run just fine here (linux, shared libperl.so, etc - very similar to yours)
Regards,
Adi
It can't pick the old library since it's been overwritten by the new one, I
did 'make install' and checked that it's new. Besides this exact perl has no
problems with 3 other tests reported earlier, but it does with Example::CLONE
test.
> Without the patch, the tests barf as you describe; with the patch they
> run just fine here (linux, shared libperl.so, etc - very similar to yours)
But I know what's going on. I get these failures at random. So your must
repeate several times to get them. Or may need to put your machine under some
load. We are talking about t/threads.t The failure of test depends on the
timing of the spawned threads and the parent thread's exit times. Try to play
with sleep()/select in read_test and at the main thread:
For example if I add 'sleep 1' to read_test, half of the test fails
completely, because something is broken in threads. If I make the parent
thread sleep long enough till all spawned threads are done I get all sub-tests
pass and no 'Attempt to free unreferenced scalar' messages. But this is
obviously wrong.
...
threads->new(\&read_test)->detach for 1..$threads;
sub read_test : locked {
for my $count (1..2) {
my $expected_count = $global_count+$count;
my $received = $obj->read;
is $received, $expected_str, "storage verification";
is $obj->count, $expected_count, "read $expected_count times";
sleep 1;
^^^^^^^^
}
}
# workaround the situations where the main thread exits before the
# child threads, which shouldn't be a problem since all threads are
# detached, but something is broken in perl
select(undef, undef, undef, 5.25);
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
I hope you will be able to reproduce it.
BTW, I have just a single processor.
That's right. But that problem doesn't seem to be related to your use
of Scalar::Util::weaken().
For now I'll check if it's something with CLONE ...
Regards,
Adi
That means that you were able to reproduce it, right?
> But that problem doesn't seem to be related to your use
> of Scalar::Util::weaken().
I thought it does, since it happens when you delete a weakened var. But I
could be wrong.
> For now I'll check if it's something with CLONE .
I'm seeing a similar error when deleting a totally different thing from a hash
(code ref) and it's w/o threads. I'm trying to reproduce it and see if it's
related.
Unfortunately, yes :-)
> >For now I'll check if it's something with CLONE .
It looks worse:
$ perl -mthreads -e 'threads->new(sub{my%h=(1,2);delete $h{1}})->join for 1,2'
Attempt to free unreferenced scalar: SV 0x4017fe84 at -e line 1.
> I'm seeing a similar error when deleting a totally different thing from a
> hash (code ref) and it's w/o threads. I'm trying to reproduce it and see if
> it's related.
Regards,
Adi
Fun!
And I have one more below. I'm not 100% if it's the same as yours.
>>I'm seeing a similar error when deleting a totally different thing from a
>>hash (code ref) and it's w/o threads. I'm trying to reproduce it and see if
>>it's related.
I've got it reproduced. I thought it had something to do with XSUB, but a
simple number triggers it:
#/tmp/delete
package Foo;
use Cwd;
my %objects = (foo => 1);
END { delete $objects{foo} }
package main;
use threads;
threads->new(sub { print "thread started\n";})->detach for (1..1);
sleep 1;
% perl-blead-ithread /tmp/delete
thread started
Attempt to free unreferenced scalar: SV 0x40179e5c at /tmp/delete line 9.
So it all has to do with cloned package hashes and calling 'delete' on its
members.
#--------------------
package Foo;
use Cwd;
my %objects;
my $s = 'Cwd::fastcwd';
$objects{$s} = *Cwd::fastcwd{CODE};
END {
my $orig_sub = delete $objects{$s};
#my $orig_sub = $objects{$s};
#delete $objects{$s};
no warnings 'redefine';
*$s = $orig_sub;
}
package main;
use threads;
threads->new(sub { print "thread started\n";})->detach for (1..1);
sleep 1;
#--------------------
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};
delete $objects{$s};
everything is fine.
When the 'delete' isn't called in void context (i.e. its return value is
needed) the following path is taken inside hv_delete_common:
1010:
if (d_flags & G_DISCARD)
sv = Nullsv;
else {
sv = sv_2mortal(HeVAL(entry));
HeVAL(entry) = &PL_sv_placeholder;
}
1032:
if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
HvLAZYDEL_on(hv);
else
hv_free_ent(hv, entry);
both on the else branch.
And so hv_free_ent() finally tries to decrement the reference count of
the PL_sv_placeholder global variable, which is zero :-)
(BTW, I'm still puzzled what the restricted hashes/fields/placeholder
has to do here - all I did is deleting an entry from a regular
hash)
But since #20263 PL_sv_placeholder is a real global variable -
perl_construct() may set its refcount to MAX_INT, but when the first
thread exits and perl_destruct() is called it will be set back to 0.
Subsequent threads will just use that. (see perl.c:812)
A quick fix is to remove the resetting to zero from perl_destruct().
--------------------
--- /arc/bleadperl/perl.c 2003-11-15 18:00:57.000000000 +0200
+++ ./perl.c 2003-12-20 06:25:12.000000000 +0200
@@ -809,9 +809,6 @@ perl_destruct(pTHXx)
SvREFCNT(&PL_sv_undef) = 0;
SvREADONLY_off(&PL_sv_undef);
- SvREFCNT(&PL_sv_placeholder) = 0;
- SvREADONLY_off(&PL_sv_placeholder);
-
Safefree(PL_origfilename);
PL_origfilename = Nullch;
Safefree(PL_reg_start_tmp);
--------------------
[DISCLAIMER - this is just a botch. sv_placeholder is not mutexed
and is accessed read-write by concurrent threads ]
The real fix would be to drop the 'restricted hashes' kludge completely
and replace it with something better -
It already has a story of naughty bugs, hijacking parts of the API
(using SVf_READONLY and PL_sv_undef with hashes) and causing a lot of
breakage all around.
Regards,
Adi
Or maybe stop hv_free_ent from decrementing the value's ref-count.
Around 1393 in hv.c:
if (val != &PL_sv_placeholder)
SvREFCNT_dec(val);
hv_free_ent might not be the only place though where
&PL_sv_placeholder's ref-count is touched.
Tassilo
--
$_=q#",}])!JAPH!qq(tsuJ[{@"tnirp}3..0}_$;//::niam/s~=)]3[))_$-3(rellac(=_$({
pam{rekcahbus})(rekcah{lrePbus})(lreP{rehtonabus})!JAPH!qq(rehtona{tsuJbus#;
$_=reverse,s+(?<=sub).+q#q!'"qq.\t$&."'!#+sexisexiixesixeseg;y~\n~~dddd;eval
> > But since #20263 PL_sv_placeholder is a real global variable -
> > perl_construct() may set its refcount to MAX_INT, but when the first
> > thread exits and perl_destruct() is called it will be set back to 0.
> > Subsequent threads will just use that. (see perl.c:812)
> >
> > A quick fix is to remove the resetting to zero from perl_destruct().
>
> Or maybe stop hv_free_ent from decrementing the value's ref-count.
> Around 1393 in hv.c:
>
> if (val != &PL_sv_placeholder)
> SvREFCNT_dec(val);
>
> hv_free_ent might not be the only place though where
> &PL_sv_placeholder's ref-count is touched.
This feels wrong.
Adi's suggestion sounds more right, because I thought that PL_sv_placeholder
was supposed to have the same immortality as PL_sv_undef.
(ie is this bug new with PL_sv_placeholder? If so, PL_sv_placeholder's
handling is buggy, not the code in hv.c)
Nicholas Clark
I may be wrong, but I think that doing all the fields and restricted
hashes stuff from an external XS module is perfectly feasible.
(and hopefully an XS module that works with older Perl versions too)
I'll try that.
Until then, pushing further #20263 and removing the stuff from
perl_destruct() should resolve the immediate problem.
The way the actual implementation clobbers the API, slows down regular
hashes accesses and complicates common code with special cases is
unacceptable IMO.
Regards,
Adi
PS.
Why is the hash value computed twice at hv.c:958-963 ?
This would be good.
> Until then, pushing further #20263 and removing the stuff from
> perl_destruct() should resolve the immediate problem.
It's not clear what you mean by "pushing further #20263"
http://public.activestate.com/cgi-bin/perlbrowse?patch=20263
Unless you mean ensuring that it is handled in all places identically
to PL_sv_yes, PL_sv_no and PL_sv_undef
> The way the actual implementation clobbers the API, slows down regular
> hashes accesses and complicates common code with special cases is
> unacceptable IMO.
Are there any figures on "slows down"?
Having tried to benchmark the effect of minor changes to the perl core
and found it very hard to get anything meaningfully above statistical
noise, I am refusing to accept the seriousness of any such claims without
evidence to back them up.
I agree with the other two arguments against them. However, I cannot see
how they can be removed from 5.8.x, and it's Hugo's call on what happens
for 5.10
Nicholas Clark
IIRC, PL_sv_placeholder (when you (?) introduced it) was acting just
like PL_sv_undef. 20263 has changed to a real global because it was
badly breaking Storable. When that change happened the chunk from
perl_destruct() wasn't removed as it should.
> > The way the actual implementation clobbers the API, slows down regular
> > hashes accesses and complicates common code with special cases is
> > unacceptable IMO.
>
> Are there any figures on "slows down"?
>
> Having tried to benchmark the effect of minor changes to the perl core
> and found it very hard to get anything meaningfully above statistical
> noise
The billions of mallocs Perl does in "regular" scripts (take for
example pod2html) may give the impression that any (even serious)
speed regression is just statistical noise.
Please don't let this cover the evidence - people wrote smart scripts
that avoid the most tedious parts of perl. And hash access speed is
critical for decent performance everywhere.
When I have the time to build some non-debugging perls in different
configurations w/ w/out placeholders I'll show you some figures.
> I agree with the other two arguments against them. However, I cannot see
> how they can be removed from 5.8.x, and it's Hugo's call on what happens
> for 5.10
I don't want to force anything that breaks binary or API compatibility.
Regards,
Adi
> Why is the hash value computed twice at hv.c:958-963 ?
Because I didn't integrate the relevant part of 21838 back to blead.
Which serves me right for not doing things the "usual" way round
(Or at least my usual way round)
Thanks for spotting this.
Nicholas Clark
Until something better pops up, I've applied my changes to blead
(#21936, #21937).
It seems that the perl5-changes relaying still doesn't smell me
(even with a valid email address) so they don't appear there :-)
Regards,
Adi
I see two messages in the approval queue for p5c from you. The
moderator will likely get to them in the next 24 hours or so.
-R
looks good to me with perl-blead@21951, My Example::CLONE test is happy.
what would it take to get these changes back into maint? perl-maint@21949
still produces the dreaded 'Attempt to free unreferenced scalar' on the code
below. I won't be around till Dec 30th, so it'd be great if someone could make
sure that the required fix makes it into 5.8.3. Thanks a lot!
#/tmp/delete
package Foo;
use Cwd;
my %objects;
my $s = 'Cwd::fastcwd';
$objects{$s} = *Cwd::fastcwd{CODE};
END {
my $orig_sub = delete $objects{$s};
#my $orig_sub = $objects{$s};
#delete $objects{$s};
no warnings 'redefine';
*$s = $orig_sub;
}
package main;
use threads;
threads->new(sub { print "thread started\n";})->detach for (1..1);
__________________________________________________________________
A: regression test. Mmm. I suspect that your example can easily be turned
into one
> could make sure that the required fix makes it into 5.8.3. Thanks a lot!
B: I don't like this change. It doesn't feel right. Why should
PL_sv_placeholder be treated differently from PL_sv_undef?
To me this implies either that it's compensating for some bug elsewhere
in how PL_sv_undef is handled, or PL_sv_undef itself has a bug which
needs fixing in this way.
Nicholas Clark
I'm not sure what's the best location for this test. It seems that it's a
wrong idea to make ext/threads to make dependent on test.pl (since I thought
Arthur has planned to put them on CPAN). So currently you can drop this test
anywhere under ./t (e.g. t/threads.t to start with and move elsewhere as their
number grows). I think it's fine to put these tests under /t since they don't
test threads, but normal perl features under threads.
I've included 3 sub-tests here (report #24660, #24663 and Adi's test). The 2nd
and 3rd pass with the current maint, but I didn't want to lose them. The 1st
one passes with current blead, but not maint.
# t/threads.t
BEGIN {
chdir 't' if -d 't';
unshift @INC, '../lib';
require './test.pl'; # for which_perl() etc
}
use strict;
use Config;
BEGIN {
if (!$Config{useithreads}) {
print "1..0 # Skip: no ithreads\n";
exit;
}
plan(3);
}
# test that we don't get:
# Attempt to free unreferenced scalar: SV 0x40173f3c
fresh_perl_is(<<'EOI', 'ok', { }, 'delete() under threads');
use threads;
threads->new(sub { my %h=(1,2); delete $h{1}})->join for 1..2;
print "ok";
EOI
#PR24660
# test that we don't get:
# Attempt to free unreferenced scalar: SV 0x814e0dc.
fresh_perl_is(<<'EOI', 'ok', { }, 'weaken ref under threads');
use threads;
use Scalar::Util;
my $data = "a";
my $obj = \$data;
my $copy = $obj;
Scalar::Util::weaken($copy);
threads->new(sub { 1 })->join for (1..1);
print "ok";
#PR24663
# test that we don't get:
# panic: magic_killbackrefs.
# Scalars leaked: 3
fresh_perl_is(<<'EOI', 'ok', { }, 'weaken ref #2 under threads');
package Foo;
sub new { bless {},shift }
package main;
use threads;
use Scalar::Util qw(weaken);
my $object = Foo->new;
my $ref = $object;
weaken $ref;
threads->new(sub { $ref = $object } )->join; # $ref = $object causes problems
print "ok";
EOI
I added it as t/op/threads.t to bleadperl (#22186) (disabling it when run
under miniperl, which can't load threads.pm).