[p5sagit/Devel-Size.git] / t / recurse.t

#!/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;
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 => 16 + 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
my $array = [ 1,2,3,4 ]; pop @$array; pop @$array;

# 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;

is ($ptr_size % 4, 0, '4 pointers are dividable by 4');
isnt ($ptr_size, 0, '4 pointers are not zero');

# size of one slot ptr
$ptr_size /= 4;

#############################################################################
# assert hash and hash key size

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");
    }
}
Commit	Line	Data
b1e5ad85	1	#!/usr/bin/perl -w
b1e5ad85	2
c8db37d3	3	# IMPORTANT NOTE:
	4	#
	5	# When testing total_size(), always remember that it dereferences things, so
	6	# total_size([]) will NOT return the size of the ref + the array, it will only
	7	# return the size of the array alone!
	8
db519f11	9	use Test::More;
b1e5ad85	10	use strict;
6c3d85e7	11	use Devel::Size ':all';
9fc9ab86	12
db519f11	13	my %types = (
	14	NULL => undef,
	15	IV => 42,
	16	RV => \1,
	17	NV => 3.14,
	18	PV => "Perl rocks",
	19	PVIV => do { my $a = 1; $a = "One"; $a },
	20	PVNV => do { my $a = 3.14; $a = "Mmm, pi"; $a },
	21	PVMG => do { my $a = $!; $a = "Bang!"; $a },
	22	);
	23
	24	plan(tests => 16 + 4 12 + 2 scalar keys %types);
	25
b1e5ad85	26	#############################################################################
c8db37d3	27	# verify that pointer sizes in array slots are sensible:
	28	# create an array with 4 slots, 2 of them used
	29	my $array = [ 1,2,3,4 ]; pop @$array; pop @$array;
	30
	31	# the total size minus the array itself minus two scalars is 4 slots
	32	my $ptr_size = total_size($array) - total_size( [] ) - total_size(1) * 2;
	33
	34	is ($ptr_size % 4, 0, '4 pointers are dividable by 4');
	35	isnt ($ptr_size, 0, '4 pointers are not zero');
	36
	37	# size of one slot ptr
	38	$ptr_size /= 4;
	39
	40	#############################################################################
	41	# assert hash and hash key size
b1e5ad85	42
b1e5ad85	43	my $hash = {};
c8db37d3	44	$hash->{a} = 1;
9fc9ab86	45	is (total_size($hash),
	46	total_size( { a => undef } ) + total_size(1) - total_size(undef),
	47	'assert hash and hash key size');
b1e5ad85	48
c8db37d3	49	#############################################################################
c8db37d3	50	# #24846 (Does not correctly recurse into references in a PVNV-type scalar)
b1e5ad85	51
c8db37d3	52	# run the following tests with different sizes
	53
	54	for my $size (2, 3, 7, 100)
	55	{
	56	my $hash = { a => 1 };
	57
	58	# hash + key minus the value
	59	my $hash_size = total_size($hash) - total_size(1);
	60
	61	$hash->{a} = 0/1;
	62	$hash->{a} = [];
	63
	64	my $pvnv_size = total_size(\$hash->{a}) - total_size([]);
	65	# size of one ref
	66	my $ref_size = total_size(\\1) - total_size(1);
	67
	68	# $hash->{a} is now a PVNV, e.g. a scalar NV and a ref to an array:
	69	# SV = PVNV(0x81ff9a8) at 0x8170d48
	70	# REFCNT = 1
	71	# FLAGS = (ROK)
	72	# IV = 0
	73	# NV = 0
	74	# RV = 0x81717bc
	75	# SV = PVAV(0x8175d6c) at 0x81717bc
	76	# REFCNT = 1
	77	# FLAGS = ()
	78	# IV = 0
	79	# NV = 0
	80	# ARRAY = 0x0
	81	# FILL = -1
	82	# MAX = -1
	83	# ARYLEN = 0x0
	84	# FLAGS = (REAL)
	85	# PV = 0x81717bc ""
	86	# CUR = 0
	87	# LEN = 0
	88
	89	# Compare this to a plain array ref
	90	#SV = RV(0x81a2834) at 0x8207a2c
	91	# REFCNT = 1
	92	# FLAGS = (TEMP,ROK)
	93	# RV = 0x8170b44
	94	# SV = PVAV(0x8175d98) at 0x8170b44
	95	# REFCNT = 2
	96	# FLAGS = ()
	97	# IV = 0
	98	# NV = 0
	99	# ARRAY = 0x0
	100	# FILL = -1
	101	# MAX = -1
	102	# ARYLEN = 0x0
	103
	104	# Get the size of the PVNV and the contained array
	105	my $element_size = total_size(\$hash->{a});
	106
1c566e6a	107	cmp_ok($element_size, '<', total_size($hash), "element < hash with one element");
1c566e6a	108	cmp_ok($element_size, '>', total_size(\[]), "PVNV + [] > [] alone");
c8db37d3	109
	110	# Dereferencing the PVNV (the argument to total_size) leaves us with
	111	# just the array, and this should be equal to a dereferenced array:
	112	is (total_size($hash->{a}), total_size([]), '[] vs. []');
	113
	114	# the hash with one key
	115	# the PVNV in the hash
	116	# the RV inside the PVNV
	117	# the contents of the array (array size)
	118
	119	my $full_hash = total_size($hash);
	120	my $array_size = total_size([]);
	121	is ($full_hash, $element_size + $hash_size, 'properly recurses into PVNV');
	122	is ($full_hash, $array_size + $pvnv_size + $hash_size, 'properly recurses into PVNV');
	123
	124	$hash->{a} = [0..$size];
	125
	126	# the outer references stripped away, so they should be the same
	127	is (total_size([0..$size]), total_size( $hash->{a} ), "hash element vs. array");
	128
	129	# the outer references included, one is just a normal ref, while the other
	130	# is a PVNV, so they shouldn't be the same:
	131	isnt (total_size(\[0..$size]), total_size( \$hash->{a} ), "[0..size] vs PVNV");
	132	# and the plain ref should be smaller
1c566e6a	133	cmp_ok(total_size(\[0..$size]), '<', total_size( \$hash->{a} ), "[0..size] vs. PVNV");
c8db37d3	134
	135	$full_hash = total_size($hash);
	136	$element_size = total_size(\$hash->{a});
	137	$array_size = total_size(\[0..$size]);
	138
	139	print "# full_hash = $full_hash\n";
	140	print "# hash_size = $hash_size\n";
	141	print "# array size: $array_size\n";
	142	print "# element size: $element_size\n";
	143	print "# ref_size = $ref_size\n";
	144	print "# pvnv_size: $pvnv_size\n";
	145
	146	# the total size is:
	147
	148	# the hash with one key
	149	# the PVNV in the hash
	150	# the RV inside the PVNV
	151	# the contents of the array (array size)
	152
	153	is ($full_hash, $element_size + $hash_size, 'properly recurses into PVNV');
	154	# is ($full_hash, $array_size + $pvnv_size + $hash_size, 'properly recurses into PVNV');
	155
	156	#############################################################################
	157	# repeat the former test, but mix in some undef elements
b1e5ad85	158
c8db37d3	159	$array_size = total_size(\[0..$size, undef, undef]);
b1e5ad85	160
c8db37d3	161	$hash->{a} = [0..$size, undef, undef];
	162	$element_size = total_size(\$hash->{a});
	163	$full_hash = total_size($hash);
b1e5ad85	164
c8db37d3	165	print "# full_hash = $full_hash\n";
	166	print "# hash_size = $hash_size\n";
	167	print "# array size: $array_size\n";
	168	print "# element size: $element_size\n";
	169	print "# ref_size = $ref_size\n";
	170	print "# pvnv_size: $pvnv_size\n";
	171
	172	is ($full_hash, $element_size + $hash_size, 'properly recurses into PVNV');
	173
	174	#############################################################################
	175	# repeat the former test, but use a pre-extended array
b1e5ad85	176
c8db37d3	177	$array = [ 0..$size, undef, undef ]; pop @$array;
b1e5ad85	178
c8db37d3	179	$array_size = total_size($array);
	180	my $scalar_size = total_size(1) * (1+$size) + total_size(undef) * 1 + $ptr_size
	181	+ $ptr_size * ($size + 2) + total_size([]);
	182	is ($scalar_size, $array_size, "computed right size if full array");
b1e5ad85	183
c8db37d3	184	$hash->{a} = [0..$size, undef, undef]; pop @{$hash->{a}};
	185	$full_hash = total_size($hash);
	186	$element_size = total_size(\$hash->{a});
	187	$array_size = total_size(\$array);
b1e5ad85	188
c8db37d3	189	print "# full_hash = $full_hash\n";
	190	print "# hash_size = $hash_size\n";
	191	print "# array size: $array_size\n";
	192	print "# element size: $element_size\n";
	193	print "# ref_size = $ref_size\n";
	194	print "# pvnv_size: $pvnv_size\n";
b1e5ad85	195
c8db37d3	196	is ($full_hash, $element_size + $hash_size, 'properly handles undef/non-undef inside arrays');
b1e5ad85	197
c8db37d3	198	} # end for different sizes
1d6fef94	199
	200	sub cmp_array_ro {
	201	my($got, $want, $desc) = @_;
	202	local $Test::Builder::Level = $Test::Builder::Level + 1;
	203	is(@$got, @$want, "$desc (same element count)");
	204	my $i = @$want;
	205	while ($i--) {
	206	is($got->[$i], $want->[$i], "$desc (element $i)");
	207	}
	208	}
	209
	210	{
	211	my $undef;
	212	my $undef_size = total_size($undef);
	213	cmp_ok($undef_size, '>', 0, 'non-zero size for NULL');
	214
	215	my $iv_size = total_size(1);
	216	cmp_ok($iv_size, '>', 0, 'non-zero size for IV');
	217
	218	# Force the array to allocate storage for elements.
	219	# This avoids making the assumption that just because it doesn't happen
	220	# initially now, it won't stay that way forever.
	221	my @array = 42;
	222	my $array_1_size = total_size(\@array);
	223	cmp_ok($array_1_size, '>', 0, 'non-zero size for array with 1 element');
	224
	225	$array[2] = 6 * 9;
	226
	227	my @copy = @array;
	228
	229	# This might be making too many assumptions about the current implementation
	230	my $array_2_size = total_size(\@array);
	231	is($array_2_size, $array_1_size + $iv_size,
	232	"gaps in arrays don't allocate scalars");
	233
	234	# Avoid using is_deeply() as that will read $#array, which is a write
	235	# action prior to 5.12. (Different writes on 5.10 and 5.8-and-earlier, but
	236	# a write either way, allocating memory.
	237	cmp_array_ro(\@array, \@copy, 'two arrays compare the same');
	238
	239	# A write action:
	240	$array[1] = undef;
	241
	242	is(total_size(\@array), $array_2_size + $undef_size,
	243	"assigning undef to a gap in an array allocates a scalar");
	244
	245	cmp_array_ro(\@array, \@copy, 'two arrays compare the same');
	246	}
db519f11	247
	248	{
	249	my %sizes;
	250	# reverse sort ensures that PVIV, PVNV and RV are processed before
	251	# IV, NULL, or NV :-)
	252	foreach my $type (reverse sort keys %types) {
	253	# Need to make sure this goes in a new scalar every time. Putting it
	254	# directly in a lexical means that it's in the pad, and the pad recycles
	255	# scalars, a side effect of which is that they get upgraded in ways we
	256	# don't really want
	257	my $a;
	258	$a->[0] = $types{$type};
	259	undef $a->[0];
	260
	261	my $expect = $sizes{$type} = size(\$a->[0]);
	262
	263	$a->[0] = \('x' x 1024);
	264
	265	$expect = $sizes{RV} if $type eq 'NULL';
	266	$expect = $sizes{PVNV} if $type eq 'NV';
	267	$expect = $sizes{PVIV} if $type eq 'IV' && $] < 5.012;
	268
	269	# Remember, size() removes a level of referencing if present. So add
	270	# one, so that we get the size of our reference:
	271	is(size(\$a->[0]), $expect,
	272	"Type $type containing a reference, size() does not recurse to the referent");
	273	cmp_ok(total_size(\$a->[0]), '>', 1024,
	274	"Type $type, total_size() recurses to the referent");
	275	}
	276	}