X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Frecurse.t;h=3f5d1b7190d72ba3e2345bbdebd1dbe31f970fb5;hb=0f6519384a2c1182532e669235866c459dbd17d2;hp=01a9ba11814f57fb239bf1cd096326e5c7898c52;hpb=8d1f46c5ea38e057de3ade70c5d81256aea7f873;p=p5sagit%2FDevel-Size.git

diff --git a/t/recurse.t b/t/recurse.t
index 01a9ba1..3f5d1b7 100644
--- a/t/recurse.t
+++ b/t/recurse.t
@@ -8,26 +8,20 @@
 
 use Test::More;
 use strict;
+use Devel::Size ':all';
 
-BEGIN
-   {
-   chdir 't' if -d 't';
-   plan tests => 6 + 4 * 12;
+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 },
+);
 
-   use lib '../lib';
-   use lib '../blib/arch';
-   use_ok('Devel::Size');
-   }
-
-can_ok ('Devel::Size', qw/
-  size
-  total_size
-  /);
-
-Devel::Size->import( qw(size total_size) );
-
-die ("Uhoh, test uses an outdated version of Devel::Size")
-  unless is ($Devel::Size::VERSION, '0.72_52', 'VERSION MATCHES');
+plan(tests => 20 + 4 * 12 + 2 * scalar keys %types);
 
 #############################################################################
 # verify that pointer sizes in array slots are sensible:
@@ -46,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');
 
 #############################################################################
@@ -183,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");
 
@@ -202,3 +204,91 @@ for my $size (2, 3, 7, 100)
   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");
+    }
+}
+
+{
+    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::));