t/recurse.t

   1 #!/usr/bin/perl -w
   2
   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
   9 use Test::More;
  10 use strict;
  11 use Devel::Size ':all';
  12
  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 => 20 + 4 * 12 + 2 * scalar keys %types);
  25
  26 #############################################################################
  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
  42
  43 # Note, undef puts PL_sv_undef on perl's stack. Assigning to a hash or array
  44 # value is always copying, so { a => undef } has a value which is a fresh
  45 # (allocated) SVt_NULL. Nowever, total_size(undef) isn't a copy, so total_size()
  46 # sees PL_sv_undef, which is a singleton, interpreter wide, so isn't counted as
  47 # part of the size. So we need to use an unassigned scalar to get the correct
  48 # size for a SVt_NULL:
  49 my $undef;
  50
  51 my $hash = {};
  52 $hash->{a} = 1;
  53 is (total_size($hash),
  54     total_size( { a => undef } ) + total_size(1) - total_size($undef),
  55     'assert hash and hash key size');
  56
  57 #############################################################################
  58 # #24846 (Does not correctly recurse into references in a PVNV-type scalar)
  59
  60 # run the following tests with different sizes
  61
  62 for my $size (2, 3, 7, 100)
  63   {
  64   my $hash = { a => 1 };
  65
  66   # hash + key minus the value
  67   my $hash_size = total_size($hash) - total_size(1);
  68
  69   $hash->{a} = 0/1;
  70   $hash->{a} = [];
  71
  72   my $pvnv_size = total_size(\$hash->{a}) - total_size([]);
  73   # size of one ref
  74   my $ref_size = total_size(\\1) - total_size(1);
  75
  76   # $hash->{a} is now a PVNV, e.g. a scalar NV and a ref to an array:
  77 #  SV = PVNV(0x81ff9a8) at 0x8170d48
  78 #  REFCNT = 1
  79 #  FLAGS = (ROK)
  80 #  IV = 0
  81 #  NV = 0
  82 #  RV = 0x81717bc
  83 #  SV = PVAV(0x8175d6c) at 0x81717bc
  84 #    REFCNT = 1
  85 #    FLAGS = ()
  86 #    IV = 0
  87 #    NV = 0
  88 #    ARRAY = 0x0
  89 #    FILL = -1
  90 #    MAX = -1
  91 #    ARYLEN = 0x0
  92 #    FLAGS = (REAL)
  93 #  PV = 0x81717bc ""
  94 #  CUR = 0
  95 #  LEN = 0
  96
  97   # Compare this to a plain array ref
  98 #SV = RV(0x81a2834) at 0x8207a2c
  99 #  REFCNT = 1
 100 #  FLAGS = (TEMP,ROK)
 101 #  RV = 0x8170b44
 102 #  SV = PVAV(0x8175d98) at 0x8170b44
 103 #    REFCNT = 2
 104 #    FLAGS = ()
 105 #    IV = 0
 106 #    NV = 0
 107 #    ARRAY = 0x0
 108 #    FILL = -1
 109 #    MAX = -1
 110 #    ARYLEN = 0x0
 111
 112   # Get the size of the PVNV and the contained array
 113   my $element_size = total_size(\$hash->{a});
 114
 115   cmp_ok($element_size, '<', total_size($hash), "element < hash with one element");
 116   cmp_ok($element_size, '>', total_size(\[]), "PVNV + [] > [] alone");
 117
 118   # Dereferencing the PVNV (the argument to total_size) leaves us with
 119   # just the array, and this should be equal to a dereferenced array:
 120   is (total_size($hash->{a}), total_size([]), '[] vs. []');
 121
 122   # the hash with one key
 123   # the PVNV in the hash
 124   # the RV inside the PVNV
 125   # the contents of the array (array size)
 126
 127   my $full_hash = total_size($hash);
 128   my $array_size = total_size([]);
 129   is ($full_hash, $element_size + $hash_size, 'properly recurses into PVNV');
 130   is ($full_hash, $array_size + $pvnv_size + $hash_size, 'properly recurses into PVNV');
 131
 132   $hash->{a} = [0..$size];
 133
 134   # the outer references stripped away, so they should be the same
 135   is (total_size([0..$size]), total_size( $hash->{a} ), "hash element vs. array");
 136
 137   # the outer references included, one is just a normal ref, while the other
 138   # is a PVNV, so they shouldn't be the same:
 139   isnt (total_size(\[0..$size]), total_size( \$hash->{a} ), "[0..size] vs PVNV");
 140   # and the plain ref should be smaller
 141   cmp_ok(total_size(\[0..$size]), '<', total_size( \$hash->{a} ), "[0..size] vs. PVNV");
 142
 143   $full_hash = total_size($hash);
 144   $element_size = total_size(\$hash->{a});
 145   $array_size = total_size(\[0..$size]);
 146
 147   print "# full_hash = $full_hash\n";
 148   print "# hash_size = $hash_size\n";
 149   print "# array size: $array_size\n";
 150   print "# element size: $element_size\n";
 151   print "# ref_size = $ref_size\n";
 152   print "# pvnv_size: $pvnv_size\n";
 153
 154   # the total size is:
 155
 156   # the hash with one key
 157   # the PVNV in the hash
 158   # the RV inside the PVNV
 159   # the contents of the array (array size)
 160
 161   is ($full_hash, $element_size + $hash_size, 'properly recurses into PVNV');
 162 #  is ($full_hash, $array_size + $pvnv_size + $hash_size, 'properly recurses into PVNV');
 163
 164 #############################################################################
 165 # repeat the former test, but mix in some undef elements
 166
 167   $array_size = total_size(\[0..$size, undef, undef]);
 168
 169   $hash->{a} = [0..$size, undef, undef];
 170   $element_size = total_size(\$hash->{a});
 171   $full_hash = total_size($hash);
 172
 173   print "# full_hash = $full_hash\n";
 174   print "# hash_size = $hash_size\n";
 175   print "# array size: $array_size\n";
 176   print "# element size: $element_size\n";
 177   print "# ref_size = $ref_size\n";
 178   print "# pvnv_size: $pvnv_size\n";
 179
 180   is ($full_hash, $element_size + $hash_size, 'properly recurses into PVNV');
 181
 182 #############################################################################
 183 # repeat the former test, but use a pre-extended array
 184
 185   $array = [ 0..$size, undef, undef ]; pop @$array;
 186
 187   $array_size = total_size($array);
 188   my $scalar_size = total_size(1) * (1+$size) + total_size($undef) * 1 + $ptr_size
 189     + $ptr_size * ($size + 2) + total_size([]);
 190   is ($scalar_size, $array_size, "computed right size if full array");
 191
 192   $hash->{a} = [0..$size, undef, undef]; pop @{$hash->{a}};
 193   $full_hash = total_size($hash);
 194   $element_size = total_size(\$hash->{a});
 195   $array_size = total_size(\$array);
 196
 197   print "# full_hash = $full_hash\n";
 198   print "# hash_size = $hash_size\n";
 199   print "# array size: $array_size\n";
 200   print "# element size: $element_size\n";
 201   print "# ref_size = $ref_size\n";
 202   print "# pvnv_size: $pvnv_size\n";
 203
 204   is ($full_hash, $element_size + $hash_size, 'properly handles undef/non-undef inside arrays');
 205
 206   } # end for different sizes
 207
 208 sub cmp_array_ro {
 209     my($got, $want, $desc) = @_;
 210     local $Test::Builder::Level = $Test::Builder::Level + 1;
 211     is(@$got, @$want, "$desc (same element count)");
 212     my $i = @$want;
 213     while ($i--) {
 214         is($got->[$i], $want->[$i], "$desc (element $i)");
 215     }
 216 }
 217
 218 {
 219     my $undef;
 220     my $undef_size = total_size($undef);
 221     cmp_ok($undef_size, '>', 0, 'non-zero size for NULL');
 222
 223     my $iv_size = total_size(1);
 224     cmp_ok($iv_size, '>', 0, 'non-zero size for IV');
 225
 226     # Force the array to allocate storage for elements.
 227     # This avoids making the assumption that just because it doesn't happen
 228     # initially now, it won't stay that way forever.
 229     my @array = 42;
 230     my $array_1_size = total_size(\@array);
 231     cmp_ok($array_1_size, '>', 0, 'non-zero size for array with 1 element');
 232
 233     $array[2] = 6 * 9;
 234
 235     my @copy = @array;
 236
 237     # This might be making too many assumptions about the current implementation
 238     my $array_2_size = total_size(\@array);
 239     is($array_2_size, $array_1_size + $iv_size,
 240        "gaps in arrays don't allocate scalars");
 241
 242     # Avoid using is_deeply() as that will read $#array, which is a write
 243     # action prior to 5.12. (Different writes on 5.10 and 5.8-and-earlier, but
 244     # a write either way, allocating memory.
 245     cmp_array_ro(\@array, \@copy, 'two arrays compare the same');
 246
 247     # A write action:
 248     $array[1] = undef;
 249
 250     is(total_size(\@array), $array_2_size + $undef_size,
 251        "assigning undef to a gap in an array allocates a scalar");
 252
 253     cmp_array_ro(\@array, \@copy, 'two arrays compare the same');
 254 }
 255
 256 {
 257     my %sizes;
 258     # reverse sort ensures that PVIV, PVNV and RV are processed before
 259     # IV, NULL, or NV :-)
 260     foreach my $type (reverse sort keys %types) {
 261         # Need to make sure this goes in a new scalar every time. Putting it
 262         # directly in a lexical means that it's in the pad, and the pad recycles
 263         # scalars, a side effect of which is that they get upgraded in ways we
 264         # don't really want
 265         my $a;
 266         $a->[0] = $types{$type};
 267         undef $a->[0];
 268
 269         my $expect = $sizes{$type} = size(\$a->[0]);
 270
 271         $a->[0] = \('x' x 1024);
 272
 273         $expect = $sizes{RV} if $type eq 'NULL';
 274         $expect = $sizes{PVNV} if $type eq 'NV';
 275         $expect = $sizes{PVIV} if $type eq 'IV' && $] < 5.012;
 276
 277         # Remember, size() removes a level of referencing if present. So add
 278         # one, so that we get the size of our reference:
 279         is(size(\$a->[0]), $expect,
 280            "Type $type containing a reference, size() does not recurse to the referent");
 281         cmp_ok(total_size(\$a->[0]), '>', 1024,
 282                "Type $type, total_size() recurses to the referent");
 283     }
 284 }
 285
 286 # The intent of the following block of tests was to avoid repeating the
 287 # potential regression if one changes how hashes are iterated. Specifically,
 288 # commit f3cf7e20cc2a7a5a moves the iteration over hash values from total_size()
 289 # to sv_size(). The final commit is complex, and somewhat a hack, as described
 290 # in the comment in Size.xs above the definition of "NO_RECURSION".
 291
 292 # My original assumption was that the change (moving the iteration) was going to
 293 # be simple, and look something like this:
 294
 295 =for a can of worms :-(
 296
 297 --- Size.xs     2015-03-20 21:00:31.000000000 +0100
 298 +++ ../Devel-Size-messy/Size.xs 2015-03-20 20:51:19.000000000 +0100
 299 @@ -615,6 +615,8 @@
 300                st->total_size += HEK_BASESIZE + cur_entry->hent_hek->hek_len + 2;
 301              }
 302            }
 303 +          if (recurse)
 304 +              sv_size(aTHX_ st, HeVAL(cur_entry), recurse);
 305            cur_entry = cur_entry->hent_next;
 306          }
 307        }
 308 @@ -828,17 +830,6 @@
 309          }
 310        }
 311        TAG;break;
 312 -
 313 -    case SVt_PVHV: TAG;
 314 -      dbg_printf(("# Found type HV\n"));
 315 -      /* Is there anything in here? */
 316 -      if (hv_iterinit((HV *)thing)) {
 317 -        HE *temp_he;
 318 -        while ((temp_he = hv_iternext((HV *)thing))) {
 319 -          av_push(pending_array, hv_iterval((HV *)thing, temp_he));
 320 -        }
 321 -      }
 322 -      TAG;break;
 323
 324      case SVt_PVGV: TAG;
 325        dbg_printf(("# Found type GV\n"));
 326
 327 =cut
 328
 329 # nice and clean, removes 11 lines of special case clause for SVt_PVHV, adding
 330 # only 2 into an existing loop.
 331
 332 # And it opened up a total can of worms. Existing tests failed because typeglobs
 333 # in subroutines leading to symbol tables were now being followed, making
 334 # reported sizes for subroutines now massively bigger.
 335
 336 # And it turned out (or seemed to be) that subroutines could even end up
 337 # dragging in the entire symbol table in some cases. Hence a block of tests
 338 # was added to verify that the reported size of &cmp_array_ro didn't explode as
 339 # a result of this (or any further) refactoring.
 340
 341 # Obviously the patch above is broken, so it never got applied. But the test to
 342 # prevent it *did*. Which was fine for 4 years. Except that it turns out that
 343 # the test is actually sensitive to the size of Test::More::is() (because the
 344 # subroutine cmp_array_ro() calls is()). And hence the test now *fails* because
 345 # Test::More::is() got refactored.
 346
 347 # Which is a pain.
 348 # So we get back to "what are we actually trying to test?"
 349 # And really, the minimal thing that we were actually trying to test all along
 350 # was *only* that a subroutine in a package with (other) imported subroutines
 351 # doesn't get the size of their package rolled into it.
 352 # Hence *this* is what the test should have been all along:
 353
 354 {
 355     package SWIT;
 356     use Test::More;
 357     sub sees_test_more {
 358         # This subroutine is in a package whose stash now contains typeglobs
 359         # which point to subroutines in Test::More. \%Test::More:: is rather
 360         # big, and we shouldn't be counting is size as part of the size of this
 361         # (empty!) subroutine.
 362     }
 363 }
 364
 365 {
 366     # This used to be total_size(\&cmp_array_ro);
 367     my $sub_size = total_size(\&SWIT::sees_test_more);
 368     cmp_ok($sub_size, '>=', 2048, 'subroutine is at least 2K');
 369     cmp_ok($sub_size, '<=', 51200, 'subroutine is no more than 50K')
 370         or diag 'Is total_size() dragging in the entire symbol table?';
 371     cmp_ok(total_size(\%Test::More::), '>=', 102400,
 372            "Test::More's symbol table is at least 100K");
 373 }
 374
 375 cmp_ok(total_size(\%Exporter::), '>', total_size(\%Exporter::Heavy::));