#!/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';
+
+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);
+ cmp_ok($sub_size, '>=', 2048, 'subroutine is at least 2K');
+ 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::));
projects / p5sagit/Devel-Size.git / blobdiff