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