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 9use Test::More; 10use strict; 11use Devel::Size ':all'; 12use Config; 13 14my %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 25plan(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 30my $array = [ 1,2,3,4 ]; pop @$array; pop @$array; 31 32# the total size minus the array itself minus two scalars is 4 slots 33my $ptr_size = total_size($array) - total_size( [] ) - total_size(1) * 2; 34 35is ($ptr_size % 4, 0, '4 pointers are dividable by 4'); 36isnt ($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: 50my $undef; 51 52my $hash = {}; 53$hash->{a} = 1; 54is (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 63for 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 209sub 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 # As of v5.28.0 there's an optimisation to avoid repeated creation of 216 # temporaries when putting a sparse array onto the stack. It does this 217 # by taking a different trade-off - the first time it happens it stores 218 # a sentinel value in the array for "does not exist" - a kind of 219 # "whiteout". A side effect of this is that (of course) the array gets 220 # bigger. This infrastructure was then also used to fix subtle bugs when 221 # nonexistent elements in arrays were passed to a subroutine. 222 # We had been triggering that behaviour in here - in our careful and 223 # (supposedly) read-only diagnostic code. 224 # So play (fragile) whack-a-mole with the core's internals - it seems 225 # that if we copy the values first, before passing them to is(), we 226 # don't trigger the optimisation, with the desired (non-)side-effect 227 # that the array remains the same size at the end of this subroutine. 228 my $ge = $got->[$i]; 229 my $we = $want->[$i]; 230 is($ge, $we, "$desc (element $i)"); 231 } 232} 233 234{ 235 my $undef; 236 my $undef_size = total_size($undef); 237 cmp_ok($undef_size, '>', 0, 'non-zero size for NULL'); 238 239 my $iv_size = total_size(1); 240 cmp_ok($iv_size, '>', 0, 'non-zero size for IV'); 241 242 # Force the array to allocate storage for elements. 243 # This avoids making the assumption that just because it doesn't happen 244 # initially now, it won't stay that way forever. 245 my @array = 42; 246 my $array_1_size = total_size(\@array); 247 cmp_ok($array_1_size, '>', 0, 'non-zero size for array with 1 element'); 248 249 $array[2] = 6 * 9; 250 251 my @copy = @array; 252 253 # This might be making too many assumptions about the current implementation 254 my $array_2_size = total_size(\@array); 255 is($array_2_size, $array_1_size + $iv_size, 256 "gaps in arrays don't allocate scalars"); 257 258 # Avoid using is_deeply() as that will read $#array, which is a write 259 # action prior to 5.12. (Different writes on 5.10 and 5.8-and-earlier, but 260 # a write either way, allocating memory. 261 cmp_array_ro(\@array, \@copy, 'two arrays compare the same'); 262 263 # A write action: 264 $array[1] = undef; 265 266 is(total_size(\@array), $array_2_size + $undef_size, 267 "assigning undef to a gap in an array allocates a scalar"); 268 269 cmp_array_ro(\@array, \@copy, 'two arrays compare the same'); 270} 271 272{ 273 my %sizes; 274 # reverse sort ensures that PVIV, PVNV and RV are processed before 275 # IV, NULL, or NV :-) 276 foreach my $type (reverse sort keys %types) { 277 # Need to make sure this goes in a new scalar every time. Putting it 278 # directly in a lexical means that it's in the pad, and the pad recycles 279 # scalars, a side effect of which is that they get upgraded in ways we 280 # don't really want 281 my $a; 282 $a->[0] = $types{$type}; 283 undef $a->[0]; 284 285 my $expect = $sizes{$type} = size(\$a->[0]); 286 287 $a->[0] = \('x' x 1024); 288 289 $expect = $sizes{RV} if $type eq 'NULL'; 290 $expect = $sizes{PVNV} if $type eq 'NV'; 291 $expect = $sizes{PVIV} if $type eq 'IV' && $] < 5.012; 292 293 # Remember, size() removes a level of referencing if present. So add 294 # one, so that we get the size of our reference: 295 is(size(\$a->[0]), $expect, 296 "Type $type containing a reference, size() does not recurse to the referent"); 297 cmp_ok(total_size(\$a->[0]), '>', 1024, 298 "Type $type, total_size() recurses to the referent"); 299 } 300} 301 302# The intent of the following block of tests was to avoid repeating the 303# potential regression if one changes how hashes are iterated. Specifically, 304# commit f3cf7e20cc2a7a5a moves the iteration over hash values from total_size() 305# to sv_size(). The final commit is complex, and somewhat a hack, as described 306# in the comment in Size.xs above the definition of "NO_RECURSION". 307 308# My original assumption was that the change (moving the iteration) was going to 309# be simple, and look something like this: 310 311=for a can of worms :-( 312 313--- Size.xs 2015-03-20 21:00:31.000000000 +0100 314+++ ../Devel-Size-messy/Size.xs 2015-03-20 20:51:19.000000000 +0100 315@@ -615,6 +615,8 @@ 316 st->total_size += HEK_BASESIZE + cur_entry->hent_hek->hek_len + 2; 317 } 318 } 319+ if (recurse) 320+ sv_size(aTHX_ st, HeVAL(cur_entry), recurse); 321 cur_entry = cur_entry->hent_next; 322 } 323 } 324@@ -828,17 +830,6 @@ 325 } 326 } 327 TAG;break; 328- 329- case SVt_PVHV: TAG; 330- dbg_printf(("# Found type HV\n")); 331- /* Is there anything in here? */ 332- if (hv_iterinit((HV *)thing)) { 333- HE *temp_he; 334- while ((temp_he = hv_iternext((HV *)thing))) { 335- av_push(pending_array, hv_iterval((HV *)thing, temp_he)); 336- } 337- } 338- TAG;break; 339 340 case SVt_PVGV: TAG; 341 dbg_printf(("# Found type GV\n")); 342 343=cut 344 345# nice and clean, removes 11 lines of special case clause for SVt_PVHV, adding 346# only 2 into an existing loop. 347 348# And it opened up a total can of worms. Existing tests failed because typeglobs 349# in subroutines leading to symbol tables were now being followed, making 350# reported sizes for subroutines now massively bigger. 351 352# And it turned out (or seemed to be) that subroutines could even end up 353# dragging in the entire symbol table in some cases. Hence a block of tests 354# was added to verify that the reported size of &cmp_array_ro didn't explode as 355# a result of this (or any further) refactoring. 356 357# Obviously the patch above is broken, so it never got applied. But the test to 358# prevent it *did*. Which was fine for 4 years. Except that it turns out that 359# the test is actually sensitive to the size of Test::More::is() (because the 360# subroutine cmp_array_ro() calls is()). And hence the test now *fails* because 361# Test::More::is() got refactored. 362 363# Which is a pain. 364# So we get back to "what are we actually trying to test?" 365# And really, the minimal thing that we were actually trying to test all along 366# was *only* that a subroutine in a package with (other) imported subroutines 367# doesn't get the size of their package rolled into it. 368# Hence *this* is what the test should have been all along: 369 370{ 371 package SWIT; 372 use Test::More; 373 sub sees_test_more { 374 # This subroutine is in a package whose stash now contains typeglobs 375 # which point to subroutines in Test::More. \%Test::More:: is rather 376 # big, and we shouldn't be counting is size as part of the size of this 377 # (empty!) subroutine. 378 } 379} 380 381{ 382 # This used to be total_size(\&cmp_array_ro); 383 my $sub_size = total_size(\&SWIT::sees_test_more); 384 my $want = 1.5 + 0.125 * $Config{ptrsize}; 385 cmp_ok($sub_size, '>=', $want, "subroutine is at least ${want}K"); 386 cmp_ok($sub_size, '<=', 51200, 'subroutine is no more than 50K') 387 or diag 'Is total_size() dragging in the entire symbol table?'; 388 cmp_ok(total_size(\%Test::More::), '>=', 102400, 389 "Test::More's symbol table is at least 100K"); 390} 391 392cmp_ok(total_size(\%Exporter::), '>', total_size(\%Exporter::Heavy::)); 393