Bug in Devel::Size?

shmem has asked for the wisdom of the Perl Monks concerning the following question:

Recently I found strange bug, probably within Devel::Size trying to get the total_size of a code ref.

Now, the docs state

BUGS
Doesn't currently walk all the bits for code refs, formats, and IO. Those throw a warning, but a minimum size for them is returned.

but I don't expect Devel::Size to make perl segfault or abort. The bug is triggered (or reveals itself) on global destruction. My code is, erm, a bit unusual (you might say 'weird', thanks), but otherwise valid perl.

versions:
perl, v5.8.8 built for i586-linux-thread-multi
Devel::Size, v0.64

main script:

#!/usr/bin/perl -wl

use strict;
use Devel::Size qw(size total_size);

my $gen = sub {
    my $file = shift;
    my $sub  = \eval "package ".caller()."; require \"$file\"";
    my $foo  = sub { goto $$sub };
    $foo;
};

my $foo = $gen->("sub1.pl");
my $bar = $gen->("sub2.pl");

print total_size($foo);
print total_size($bar);

$bar->("monkses");
$foo->("world");
[download]

file sub1.pl :

sub {
    no warnings 'uninitialized';
    print "sub1 args(",join(",",map{ "'$_'"} caller(0)),")\n";
    print "Howdy, $_[0]!\n";
}
[download]

file sub2.pl :

sub {
    no warnings 'uninitialized';
    print "sub2 args(",join(",",map{ "'$_'"} caller(0)),")\n";
    print "Hullo, $_[0]!\n";
}
[download]

Odd. Depending on the filename of the main script, it either triggers a glibc trap, or just warns about "Attempt to free unreferenced scalar". I name it aaaa_aaa.pl:

3674
3674
sub2 args('main','aaaa_aaa.pl','18','main::__ANON__','1','','','','2',
+'UUUUUUUUUUUU')

Hullo, monkses!

sub1 args('main','aaaa_aaa.pl','19','main::__ANON__','1','','','','2',
+'UUUUUUUUUUUU')

Howdy, world!

Attempt to free unreferenced scalar: SV 0x8199430, Perl interpreter: 0
+x8166008.
Attempt to free unreferenced scalar: SV 0x8199180, Perl interpreter: 0
+x8166008.
Attempt to free unreferenced scalar: SV 0x81a3d68, Perl interpreter: 0
+x8166008.
Attempt to free unreferenced scalar: SV 0x818b340, Perl interpreter: 0
+x8166008.
Attempt to free unreferenced scalar: SV 0x818d9f0, Perl interpreter: 0
+x8166008.
Attempt to free unreferenced scalar: SV 0x8199138, Perl interpreter: 0
+x8166008.
Attempt to free unreferenced scalar: SV 0x81992b0, Perl interpreter: 0
+x8166008.
Attempt to free unreferenced scalar: SV 0x818afc8, Perl interpreter: 0
+x8166008.
Attempt to free unreferenced scalar: SV 0x816f0f8, Perl interpreter: 0
+x8166008.
[download]

I rename it to aaaa_aaaa.pl (just one 'a' added):

3675
3675
sub2 args('main','aaaa_aaaa.pl','18','main::__ANON__','1','','','','2'
+,'UUUUUUUUUUUU')

Hullo, monkses!

sub1 args('main','aaaa_aaaa.pl','19','main::__ANON__','1','','','','2'
+,'UUUUUUUUUUUU')

Howdy, world!

Attempt to free unreferenced scalar: SV 0x81991e0, Perl interpreter: 0
+x8166008.
Attempt to free unreferenced scalar: SV 0x81a3da8, Perl interpreter: 0
+x8166008.
Attempt to free unreferenced scalar: SV 0x818b378, Perl interpreter: 0
+x8166008.
Attempt to free unreferenced scalar: SV 0x818da28, Perl interpreter: 0
+x8166008.
Attempt to free unreferenced scalar: SV 0x8199198, Perl interpreter: 0
+x8166008.
Attempt to free unreferenced scalar: SV 0x8199310, Perl interpreter: 0
+x8166008.
Attempt to free unreferenced scalar: SV 0x81990d8, Perl interpreter: 0
+x8166008.
*** glibc detected *** perl: double free or corruption (fasttop): 0x08
+18ada8 ***
======= Backtrace: =========
/lib/libc.so.6[0xb7e2a9b1]
/lib/libc.so.6(__libc_free+0x84)[0xb7e2c024]
perl(Perl_op_clear+0x2b2)[0x808e002]
perl(Perl_op_free+0x8c)[0x8090afc]
perl(Perl_op_free+0x4f)[0x8090abf]
perl(Perl_op_free+0x4f)[0x8090abf]
perl(Perl_cv_undef+0x148)[0x8090e28]
perl(Perl_sv_clear+0x571)[0x80d2c71]
perl(Perl_sv_free+0x88)[0x80d2fc8]
perl(Perl_pad_undef+0x24e)[0x809dc3e]
perl(Perl_cv_undef+0x50)[0x8090d30]
perl(Perl_sv_clear+0x571)[0x80d2c71]
perl(Perl_sv_free+0x88)[0x80d2fc8]
perl(perl_destruct+0x1b8)[0x80687f8]
perl(main+0xc6)[0x8060196]
/lib/libc.so.6(__libc_start_main+0xdc)[0xb7ddc87c]
perl[0x8060041]
======= Memory map: ========
08048000-08160000 r-xp 00000000 03:02 139557     /usr/bin/perl
08160000-08164000 rw-p 00117000 03:02 139557     /usr/bin/perl
08164000-081e9000 rw-p 08164000 00:00 0          [heap]
b7c00000-b7c21000 rw-p b7c00000 00:00 0 
b7c21000-b7d00000 ---p b7c21000 00:00 0 
b7d6e000-b7d71000 r-xp 00000000 03:02 1547784    /usr/lib/perl5/site_p
+erl/5.8.8/i586-linux-thread-multi/auto/Devel/Size/Size.so
b7d71000-b7d72000 rw-p 00002000 03:02 1547784    /usr/lib/perl5/site_p
+erl/5.8.8/i586-linux-thread-multi/auto/Devel/Size/Size.so
b7d72000-b7d93000 rw-p b7d72000 00:00 0 
b7d93000-b7dc6000 r--p 00000000 03:02 164925     /usr/lib/locale/de_DE
+/LC_CTYPE
b7dc6000-b7dc7000 rw-p b7dc6000 00:00 0 
b7dc7000-b7ee0000 r-xp 00000000 03:02 1645158    /lib/libc-2.4.so
b7ee0000-b7ee2000 r--p 00118000 03:02 1645158    /lib/libc-2.4.so
b7ee2000-b7ee4000 rw-p 0011a000 03:02 1645158    /lib/libc-2.4.so
b7ee4000-b7ee7000 rw-p b7ee4000 00:00 0 
b7ee7000-b7ef6000 r-xp 00000000 03:02 1645184    /lib/libpthread-2.4.s
+o
b7ef6000-b7ef8000 rw-p 0000e000 03:02 1645184    /lib/libpthread-2.4.s
+o
b7ef8000-b7efa000 rw-p b7ef8000 00:00 0 
b7efa000-b7efc000 r-xp 00000000 03:02 1645192    /lib/libutil-2.4.so
b7efc000-b7efe000 rw-p 00001000 03:02 1645192    /lib/libutil-2.4.so
b7efe000-b7eff000 rw-p b7efe000 00:00 0 
b7eff000-b7f08000 r-xp 00000000 03:02 1645162    /lib/libcrypt-2.4.so
b7f08000-b7f0b000 rw-p 00008000 03:02 1645162    /lib/libcrypt-2.4.so
b7f0b000-b7f32000 rw-p b7f0b000 00:00 0 
b7f32000-b7f55000 r-xp 00000000 03:02 1645166    /lib/libm-2.4.so
b7f55000-b7f57000 rw-p 00022000 03:02 1645166    /lib/libm-2.4.so
b7f57000-b7f59000 r-xp 00000000 03:02 1645164    /lib/libdl-2.4.so
b7f59000-b7f5b000 rw-p 00001000 03:02 1645164    /lib/libdl-2.4.so
b7f5b000-b7f6c000 r-xp 00000000 03:02 1645169    /lib/libnsl-2.4.so
b7f6c000-b7f6e000 rw-p 00010000 03:02 1645169    /lib/libnsl-2.4.so
b7f6e000-b7f70000 rw-p b7f6e000 00:00 0 
b7f70000-b7f7a000 r-xp 00000000 03:02 1645198    /lib/libgcc_s.so.1
b7f7a000-b7f7b000 rw-p 00009000 03:02 1645198    /lib/libgcc_s.so.1
b7f7b000-b7f7c000 r--p 00000000 03:02 180211     /usr/lib/locale/de_DE
+/LC_NUMERIC
b7f7c000-b7f7d000 r--p 00000000 03:02 163736     /usr/lib/locale/de_DE
+/LC_TIME
b7f7d000-b7f82000 r--p 00000000 03:02 180271     /usr/lib/locale/de_DE
+/LC_COLLATE
b7f82000-b7f83000 r--p 00000000 03:02 180200     /usr/lib/locale/de_DE
+/LC_MONETARY
b7f83000-b7f84000 r--p 00000000 03:02 180266     /usr/lib/locale/de_DE
+/LC_PAPER
b7f84000-b7f85000 r--p 00000000 03:02 163734     /usrAborted
[download]

Seems it's Devel::Size - without asking for total_size all is fine.

A slight change to the code (shortcuts and checking for $@, quoting), which eliminates some lexicals -

#!/usr/bin/perl -wl
use strict;
use Devel::Size qw(size total_size);

my $gen = sub {
    my $sub = \eval 'package '.caller().'; require "'.shift(@_).'"';
    die $@ if $@;
    sub { goto $$sub };
};

my $foo = $gen->("sub1.pl");
my $bar = $gen->("sub2.pl");

print total_size($foo);
print total_size($bar);

$bar->("monkses");
$foo->("world");
[download]

- leads to a segfault:

3543
3543
sub2 args('main','aaaa_aaaa.pl','17','main::__ANON__','1','','','','2'
+,'UUUUUUUUUUUU')

Hullo, monkses!

sub1 args('main','aaaa_aaaa.pl','18','main::__ANON__','1','','','','2'
+,'UUUUUUUUUUUU')

Howdy, world!

Segmentation fault
[download]

Can anybody confirm that bug - or is it that I just misuse Devel::Size ?

--shmem

update: fixed missing double quote in second script variant - thanks sgt
update: added version information

_($_=" "x(1<<5)."?\n".q·/)Oo.  G°\        /
                              /\_¯/(q    /
----------------------------  \__(m.====·.(_("always off the crowd"))."·
");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}

Comment on Bug in Devel::Size? Select or Download Code

Replies are listed 'Best First'.
Re: Bug in Devel::Size? by sgt (Deacon) on Dec 22, 2006 at 12:55 UTC
On cygwin 1.5.21-2 with perl 5.8.7 I get a parse error on the second variation...(which seems normal given the lonely doublequote at the end of the eval no??) Devel::Size is 0.59 which seems to be old (latest is 0.63) UPDATE: with the modification indicated by shmem, I get the same result in both cases. latest version of Devel::Size is 0.64 (not 0.63) so the problem could also come from there % stephan@armen (/home/stephan) % % perl -MDevel::Size -e 'print $Devel::Size::VERSION' 0.59 % stephan@armen (/home/stephan) % % ./devel_size_test.px Devel::Size: Calculated sizes for CVs are incomplete 108 Devel::Size: Calculated sizes for CVs are incomplete 108 sub2 args('main','./devel_size_test.px','19','main::__ANON__','1','',' +','','2','UUUUUUUUUUUU') Hullo, monkses! sub1 args('main','./devel_size_test.px','20','main::__ANON__','1','',' +','','2','UUUUUUUUUUUU') Howdy, world! % stephan@armen (/home/stephan) % % ./devel_size_test2.px Warning: Use of "require" without parentheses is ambiguous at (eval 1) + line 1. String found where operator expected at (eval 1) line 1, at end of lin +e Can't find string terminator '"' anywhere before EOF at (eval 1) line +1. % stephan@armen (/home/stephan) % % diff devel_size_test@(\|2).px 2d1 < 7,10c6,8 < my $file = shift; < my $sub = \eval "package ".caller()."; require \"$file\""; < my $foo = sub { goto $$sub }; < $foo; --- > my $sub = \eval 'package '.caller().'; require '.shift(@_).'"'; > die $@ if $@; > sub { goto $$sub }; 21d18 < [download] hth --stephan	[reply] [d/l]
Re^2: Bug in Devel::Size? by shmem (Chancellor) on Dec 22, 2006 at 13:41 UTC
Oops... that line should be `my $sub = \eval 'package '.caller().'; require "'.shift(@_).'"';` [download] of course, since the file name must be quoted... fixed in root node. --shmem _($_=" "x(1<<5)."?\n".q·/)Oo. G°\ / /\_¯/(q / ---------------------------- \__(m.====·.(_("always off the crowd"))."· ");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}	[reply] [d/l]