X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Frecurse.t;h=2b2e1668a51a5c0b16c0de7bf9530935c788ac54;hb=a8fa215c7b5b72b98f8e6029907087b0ff176594;hp=af2eb39c68ddc9536394f77da43f746d4f0a668e;hpb=b1e5ad85e1c05c8f9a3822664645476e0924ec3e;p=p5sagit%2FDevel-Size.git diff --git a/t/recurse.t b/t/recurse.t index af2eb39..2b2e166 100644 --- a/t/recurse.t +++ b/t/recurse.t @@ -1,62 +1,377 @@ #!/usr/bin/perl -w +# IMPORTANT NOTE: +# +# When testing total_size(), always remember that it dereferences things, so +# total_size([]) will NOT return the size of the ref + the array, it will only +# return the size of the array alone! + use Test::More; use strict; - -my $tests; +use Devel::Size ':all'; +use Config; + +my %types = ( + NULL => undef, + IV => 42, + RV => \1, + NV => 3.14, + PV => "Perl rocks", + PVIV => do { my $a = 1; $a = "One"; $a }, + PVNV => do { my $a = 3.14; $a = "Mmm, pi"; $a }, + PVMG => do { my $a = $!; $a = "Bang!"; $a }, +); -BEGIN - { - chdir 't' if -d 't'; - plan tests => 5; +plan(tests => 20 + 4 * 12 + 2 * scalar keys %types); - use lib '../lib'; - use lib '../blib/arch'; - use_ok('Devel::Size'); - } +############################################################################# +# verify that pointer sizes in array slots are sensible: +# create an array with 4 slots, 2 of them used +my $array = [ 1,2,3,4 ]; pop @$array; pop @$array; -can_ok ('Devel::Size', qw/ - size - total_size - /); +# the total size minus the array itself minus two scalars is 4 slots +my $ptr_size = total_size($array) - total_size( [] ) - total_size(1) * 2; -Devel::Size->import( qw(size total_size) ); +is ($ptr_size % 4, 0, '4 pointers are dividable by 4'); +isnt ($ptr_size, 0, '4 pointers are not zero'); -die ("Uhoh, test uses outdated version of Devel::Size") - unless is ($Devel::Size::VERSION, '0.67', 'VERSION MATCHES'); +# size of one slot ptr +$ptr_size /= 4; ############################################################################# -# #24846 (Does not correctly recurse into references in a PVNV-type scalar) +# assert hash and hash key size + +# Note, undef puts PL_sv_undef on perl's stack. Assigning to a hash or array +# value is always copying, so { a => undef } has a value which is a fresh +# (allocated) SVt_NULL. Nowever, total_size(undef) isn't a copy, so total_size() +# sees PL_sv_undef, which is a singleton, interpreter wide, so isn't counted as +# part of the size. So we need to use an unassigned scalar to get the correct +# size for a SVt_NULL: +my $undef; -my $size = 100; my $hash = {}; +$hash->{a} = 1; +is (total_size($hash), + total_size( { a => undef } ) + total_size(1) - total_size($undef), + 'assert hash and hash key size'); + +############################################################################# +# #24846 (Does not correctly recurse into references in a PVNV-type scalar) + +# run the following tests with different sizes + +for my $size (2, 3, 7, 100) + { + my $hash = { a => 1 }; + + # hash + key minus the value + my $hash_size = total_size($hash) - total_size(1); + + $hash->{a} = 0/1; + $hash->{a} = []; + + my $pvnv_size = total_size(\$hash->{a}) - total_size([]); + # size of one ref + my $ref_size = total_size(\\1) - total_size(1); + + # $hash->{a} is now a PVNV, e.g. a scalar NV and a ref to an array: +# SV = PVNV(0x81ff9a8) at 0x8170d48 +# REFCNT = 1 +# FLAGS = (ROK) +# IV = 0 +# NV = 0 +# RV = 0x81717bc +# SV = PVAV(0x8175d6c) at 0x81717bc +# REFCNT = 1 +# FLAGS = () +# IV = 0 +# NV = 0 +# ARRAY = 0x0 +# FILL = -1 +# MAX = -1 +# ARYLEN = 0x0 +# FLAGS = (REAL) +# PV = 0x81717bc "" +# CUR = 0 +# LEN = 0 + + # Compare this to a plain array ref +#SV = RV(0x81a2834) at 0x8207a2c +# REFCNT = 1 +# FLAGS = (TEMP,ROK) +# RV = 0x8170b44 +# SV = PVAV(0x8175d98) at 0x8170b44 +# REFCNT = 2 +# FLAGS = () +# IV = 0 +# NV = 0 +# ARRAY = 0x0 +# FILL = -1 +# MAX = -1 +# ARYLEN = 0x0 + + # Get the size of the PVNV and the contained array + my $element_size = total_size(\$hash->{a}); + + cmp_ok($element_size, '<', total_size($hash), "element < hash with one element"); + cmp_ok($element_size, '>', total_size(\[]), "PVNV + [] > [] alone"); + + # Dereferencing the PVNV (the argument to total_size) leaves us with + # just the array, and this should be equal to a dereferenced array: + is (total_size($hash->{a}), total_size([]), '[] vs. []'); + + # the hash with one key + # the PVNV in the hash + # the RV inside the PVNV + # the contents of the array (array size) + + my $full_hash = total_size($hash); + my $array_size = total_size([]); + is ($full_hash, $element_size + $hash_size, 'properly recurses into PVNV'); + is ($full_hash, $array_size + $pvnv_size + $hash_size, 'properly recurses into PVNV'); + + $hash->{a} = [0..$size]; + + # the outer references stripped away, so they should be the same + is (total_size([0..$size]), total_size( $hash->{a} ), "hash element vs. array"); + + # the outer references included, one is just a normal ref, while the other + # is a PVNV, so they shouldn't be the same: + isnt (total_size(\[0..$size]), total_size( \$hash->{a} ), "[0..size] vs PVNV"); + # and the plain ref should be smaller + cmp_ok(total_size(\[0..$size]), '<', total_size( \$hash->{a} ), "[0..size] vs. PVNV"); + + $full_hash = total_size($hash); + $element_size = total_size(\$hash->{a}); + $array_size = total_size(\[0..$size]); + + print "# full_hash = $full_hash\n"; + print "# hash_size = $hash_size\n"; + print "# array size: $array_size\n"; + print "# element size: $element_size\n"; + print "# ref_size = $ref_size\n"; + print "# pvnv_size: $pvnv_size\n"; + + # the total size is: + + # the hash with one key + # the PVNV in the hash + # the RV inside the PVNV + # the contents of the array (array size) + + is ($full_hash, $element_size + $hash_size, 'properly recurses into PVNV'); +# is ($full_hash, $array_size + $pvnv_size + $hash_size, 'properly recurses into PVNV'); + +############################################################################# +# repeat the former test, but mix in some undef elements + + $array_size = total_size(\[0..$size, undef, undef]); + + $hash->{a} = [0..$size, undef, undef]; + $element_size = total_size(\$hash->{a}); + $full_hash = total_size($hash); + + print "# full_hash = $full_hash\n"; + print "# hash_size = $hash_size\n"; + print "# array size: $array_size\n"; + print "# element size: $element_size\n"; + print "# ref_size = $ref_size\n"; + print "# pvnv_size: $pvnv_size\n"; + + is ($full_hash, $element_size + $hash_size, 'properly recurses into PVNV'); + +############################################################################# +# repeat the former test, but use a pre-extended array + + $array = [ 0..$size, undef, undef ]; pop @$array; + + $array_size = total_size($array); + my $scalar_size = total_size(1) * (1+$size) + total_size($undef) * 1 + $ptr_size + + $ptr_size * ($size + 2) + total_size([]); + is ($scalar_size, $array_size, "computed right size if full array"); + + $hash->{a} = [0..$size, undef, undef]; pop @{$hash->{a}}; + $full_hash = total_size($hash); + $element_size = total_size(\$hash->{a}); + $array_size = total_size(\$array); + + print "# full_hash = $full_hash\n"; + print "# hash_size = $hash_size\n"; + print "# array size: $array_size\n"; + print "# element size: $element_size\n"; + print "# ref_size = $ref_size\n"; + print "# pvnv_size: $pvnv_size\n"; + + is ($full_hash, $element_size + $hash_size, 'properly handles undef/non-undef inside arrays'); + + } # end for different sizes + +sub cmp_array_ro { + my($got, $want, $desc) = @_; + local $Test::Builder::Level = $Test::Builder::Level + 1; + is(@$got, @$want, "$desc (same element count)"); + my $i = @$want; + while ($i--) { + is($got->[$i], $want->[$i], "$desc (element $i)"); + } +} + +{ + my $undef; + my $undef_size = total_size($undef); + cmp_ok($undef_size, '>', 0, 'non-zero size for NULL'); + + my $iv_size = total_size(1); + cmp_ok($iv_size, '>', 0, 'non-zero size for IV'); + + # Force the array to allocate storage for elements. + # This avoids making the assumption that just because it doesn't happen + # initially now, it won't stay that way forever. + my @array = 42; + my $array_1_size = total_size(\@array); + cmp_ok($array_1_size, '>', 0, 'non-zero size for array with 1 element'); + + $array[2] = 6 * 9; + + my @copy = @array; + + # This might be making too many assumptions about the current implementation + my $array_2_size = total_size(\@array); + is($array_2_size, $array_1_size + $iv_size, + "gaps in arrays don't allocate scalars"); + + # Avoid using is_deeply() as that will read $#array, which is a write + # action prior to 5.12. (Different writes on 5.10 and 5.8-and-earlier, but + # a write either way, allocating memory. + cmp_array_ro(\@array, \@copy, 'two arrays compare the same'); + + # A write action: + $array[1] = undef; + + is(total_size(\@array), $array_2_size + $undef_size, + "assigning undef to a gap in an array allocates a scalar"); + + cmp_array_ro(\@array, \@copy, 'two arrays compare the same'); +} + +{ + my %sizes; + # reverse sort ensures that PVIV, PVNV and RV are processed before + # IV, NULL, or NV :-) + foreach my $type (reverse sort keys %types) { + # Need to make sure this goes in a new scalar every time. Putting it + # directly in a lexical means that it's in the pad, and the pad recycles + # scalars, a side effect of which is that they get upgraded in ways we + # don't really want + my $a; + $a->[0] = $types{$type}; + undef $a->[0]; + + my $expect = $sizes{$type} = size(\$a->[0]); + + $a->[0] = \('x' x 1024); + + $expect = $sizes{RV} if $type eq 'NULL'; + $expect = $sizes{PVNV} if $type eq 'NV'; + $expect = $sizes{PVIV} if $type eq 'IV' && $] < 5.012; + + # Remember, size() removes a level of referencing if present. So add + # one, so that we get the size of our reference: + is(size(\$a->[0]), $expect, + "Type $type containing a reference, size() does not recurse to the referent"); + cmp_ok(total_size(\$a->[0]), '>', 1024, + "Type $type, total_size() recurses to the referent"); + } +} + +# The intent of the following block of tests was to avoid repeating the +# potential regression if one changes how hashes are iterated. Specifically, +# commit f3cf7e20cc2a7a5a moves the iteration over hash values from total_size() +# to sv_size(). The final commit is complex, and somewhat a hack, as described +# in the comment in Size.xs above the definition of "NO_RECURSION". + +# My original assumption was that the change (moving the iteration) was going to +# be simple, and look something like this: -my $empty_hash = total_size($hash); +=for a can of worms :-( -$hash->{a} = 0/1; -$hash->{a} = []; +--- Size.xs 2015-03-20 21:00:31.000000000 +0100 ++++ ../Devel-Size-messy/Size.xs 2015-03-20 20:51:19.000000000 +0100 +@@ -615,6 +615,8 @@ + st->total_size += HEK_BASESIZE + cur_entry->hent_hek->hek_len + 2; + } + } ++ if (recurse) ++ sv_size(aTHX_ st, HeVAL(cur_entry), recurse); + cur_entry = cur_entry->hent_next; + } + } +@@ -828,17 +830,6 @@ + } + } + TAG;break; +- +- case SVt_PVHV: TAG; +- dbg_printf(("# Found type HV\n")); +- /* Is there anything in here? */ +- if (hv_iterinit((HV *)thing)) { +- HE *temp_he; +- while ((temp_he = hv_iternext((HV *)thing))) { +- av_push(pending_array, hv_iterval((HV *)thing, temp_he)); +- } +- } +- TAG;break; + + case SVt_PVGV: TAG; + dbg_printf(("# Found type GV\n")); -my $hash_size = total_size($hash); -my $element_size = total_size($hash->{a}); +=cut -ok ($element_size < $hash_size, "element < hash with one element"); +# nice and clean, removes 11 lines of special case clause for SVt_PVHV, adding +# only 2 into an existing loop. -my $array_size = total_size([0..$size]) - total_size( [] ); +# And it opened up a total can of worms. Existing tests failed because typeglobs +# in subroutines leading to symbol tables were now being followed, making +# reported sizes for subroutines now massively bigger. -$hash->{a} = [0..$size]; -my $full_hash = total_size($hash); +# And it turned out (or seemed to be) that subroutines could even end up +# dragging in the entire symbol table in some cases. Hence a block of tests +# was added to verify that the reported size of &cmp_array_ro didn't explode as +# a result of this (or any further) refactoring. -#print "$full_hash\n"; -#print "$array_size\n"; -#print "$hash_size\n"; -#print "$element_size\n"; +# Obviously the patch above is broken, so it never got applied. But the test to +# prevent it *did*. Which was fine for 4 years. Except that it turns out that +# the test is actually sensitive to the size of Test::More::is() (because the +# subroutine cmp_array_ro() calls is()). And hence the test now *fails* because +# Test::More::is() got refactored. -# the total size is: +# Which is a pain. +# So we get back to "what are we actually trying to test?" +# And really, the minimal thing that we were actually trying to test all along +# was *only* that a subroutine in a package with (other) imported subroutines +# doesn't get the size of their package rolled into it. +# Hence *this* is what the test should have been all along: -# the contents of the array (array size) -# the hash -# the PVNV in the hash -# the RV inside the PVNV +{ + package SWIT; + use Test::More; + sub sees_test_more { + # This subroutine is in a package whose stash now contains typeglobs + # which point to subroutines in Test::More. \%Test::More:: is rather + # big, and we shouldn't be counting is size as part of the size of this + # (empty!) subroutine. + } +} -is ($full_hash, $array_size + $hash_size, 'properly recurses into PVNV'); +{ + # This used to be total_size(\&cmp_array_ro); + my $sub_size = total_size(\&SWIT::sees_test_more); + my $want = 1.5 + 0.125 * $Config{ptrsize}; + cmp_ok($sub_size, '>=', $want, "subroutine is at least ${want}K"); + cmp_ok($sub_size, '<=', 51200, 'subroutine is no more than 50K') + or diag 'Is total_size() dragging in the entire symbol table?'; + cmp_ok(total_size(\%Test::More::), '>=', 102400, + "Test::More's symbol table is at least 100K"); +} +cmp_ok(total_size(\%Exporter::), '>', total_size(\%Exporter::Heavy::));