Commit | Line | Data |
b1e5ad85 |
1 | #!/usr/bin/perl -w |
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'; |
e7d68377 |
12 | use Config; |
9fc9ab86 |
13 | |
db519f11 |
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 | |
f3cf7e20 |
25 | plan(tests => 20 + 4 * 12 + 2 * scalar keys %types); |
db519f11 |
26 | |
b1e5ad85 |
27 | ############################################################################# |
c8db37d3 |
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 |
b1e5ad85 |
43 | |
a52ceccd |
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 | |
b1e5ad85 |
52 | my $hash = {}; |
c8db37d3 |
53 | $hash->{a} = 1; |
9fc9ab86 |
54 | is (total_size($hash), |
a52ceccd |
55 | total_size( { a => undef } ) + total_size(1) - total_size($undef), |
9fc9ab86 |
56 | 'assert hash and hash key size'); |
b1e5ad85 |
57 | |
c8db37d3 |
58 | ############################################################################# |
59 | # #24846 (Does not correctly recurse into references in a PVNV-type scalar) |
b1e5ad85 |
60 | |
c8db37d3 |
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 | |
1c566e6a |
116 | cmp_ok($element_size, '<', total_size($hash), "element < hash with one element"); |
117 | cmp_ok($element_size, '>', total_size(\[]), "PVNV + [] > [] alone"); |
c8db37d3 |
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 |
1c566e6a |
142 | cmp_ok(total_size(\[0..$size]), '<', total_size( \$hash->{a} ), "[0..size] vs. PVNV"); |
c8db37d3 |
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 |
b1e5ad85 |
167 | |
c8db37d3 |
168 | $array_size = total_size(\[0..$size, undef, undef]); |
b1e5ad85 |
169 | |
c8db37d3 |
170 | $hash->{a} = [0..$size, undef, undef]; |
171 | $element_size = total_size(\$hash->{a}); |
172 | $full_hash = total_size($hash); |
b1e5ad85 |
173 | |
c8db37d3 |
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 |
b1e5ad85 |
185 | |
c8db37d3 |
186 | $array = [ 0..$size, undef, undef ]; pop @$array; |
b1e5ad85 |
187 | |
c8db37d3 |
188 | $array_size = total_size($array); |
a52ceccd |
189 | my $scalar_size = total_size(1) * (1+$size) + total_size($undef) * 1 + $ptr_size |
c8db37d3 |
190 | + $ptr_size * ($size + 2) + total_size([]); |
191 | is ($scalar_size, $array_size, "computed right size if full array"); |
b1e5ad85 |
192 | |
c8db37d3 |
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); |
b1e5ad85 |
197 | |
c8db37d3 |
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"; |
b1e5ad85 |
204 | |
c8db37d3 |
205 | is ($full_hash, $element_size + $hash_size, 'properly handles undef/non-undef inside arrays'); |
b1e5ad85 |
206 | |
c8db37d3 |
207 | } # end for different sizes |
1d6fef94 |
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 | } |
db519f11 |
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 | } |
f3cf7e20 |
286 | |
9929f0c6 |
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 | |
f3cf7e20 |
366 | { |
9929f0c6 |
367 | # This used to be total_size(\&cmp_array_ro); |
368 | my $sub_size = total_size(\&SWIT::sees_test_more); |
e7d68377 |
369 | my $want = 1.5 + 0.125 * $Config{ptrsize}; |
370 | cmp_ok($sub_size, '>=', $want, "subroutine is at least ${want}K"); |
f3cf7e20 |
371 | cmp_ok($sub_size, '<=', 51200, 'subroutine is no more than 50K') |
372 | or diag 'Is total_size() dragging in the entire symbol table?'; |
9929f0c6 |
373 | cmp_ok(total_size(\%Test::More::), '>=', 102400, |
374 | "Test::More's symbol table is at least 100K"); |
f3cf7e20 |
375 | } |
376 | |
377 | cmp_ok(total_size(\%Exporter::), '>', total_size(\%Exporter::Heavy::)); |