use Test::More;
use strict;
-
-my $tests;
+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.71', 'VERSION MATCHES');
+plan(tests => 16 + 4 *12 + 2 * scalar keys %types);
#############################################################################
# verify that pointer sizes in array slots are sensible:
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');
+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)
# Get the size of the PVNV and the contained array
my $element_size = total_size(\$hash->{a});
- ok ($element_size < total_size($hash), "element < hash with one element");
- ok ($element_size > total_size(\[]), "PVNV + [] > [] alone");
+ 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 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
- ok (total_size(\[0..$size]) < total_size( \$hash->{a} ), "[0..size] vs. PVNV");
+ 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});
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");
+ }
+}