X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Frecurse.t;h=3f5d1b7190d72ba3e2345bbdebd1dbe31f970fb5;hb=a5c6bdd7895f5ca3ffe055e7c914a39937fdf69b;hp=4bebab2c1000271162a172e2a664f616c0c53e9a;hpb=1d6fef943eaa10527312a01e19d4b7ae4044c16d;p=p5sagit%2FDevel-Size.git diff --git a/t/recurse.t b/t/recurse.t index 4bebab2..3f5d1b7 100644 --- a/t/recurse.t +++ b/t/recurse.t @@ -6,10 +6,23 @@ # 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 tests => 16 + 4 *12; +use Test::More; use strict; use Devel::Size ':all'; +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 }, +); + +plan(tests => 20 + 4 * 12 + 2 * scalar keys %types); + ############################################################################# # verify that pointer sizes in array slots are sensible: # create an array with 4 slots, 2 of them used @@ -27,10 +40,18 @@ $ptr_size /= 4; ############################################################################# # 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 $hash = {}; $hash->{a} = 1; is (total_size($hash), - total_size( { a => undef } ) + total_size(1) - total_size(undef), + total_size( { a => undef } ) + total_size(1) - total_size($undef), 'assert hash and hash key size'); ############################################################################# @@ -164,7 +185,7 @@ for my $size (2, 3, 7, 100) $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 + 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"); @@ -231,3 +252,43 @@ sub cmp_array_ro { 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"); + } +} + +{ + my $sub_size = total_size(\&cmp_array_ro); + cmp_ok($sub_size, '>=', 5120, 'subroutine is at least 5K'); + 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(\%::), '>=', 10240, 'symbol table is at least 100K'); +} + +cmp_ok(total_size(\%Exporter::), '>', total_size(\%Exporter::Heavy::));