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'; |
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 | |
f3cf7e20 |
24 | plan(tests => 20 + 4 * 12 + 2 * scalar keys %types); |
db519f11 |
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 | |
a52ceccd |
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 | |
b1e5ad85 |
51 | my $hash = {}; |
c8db37d3 |
52 | $hash->{a} = 1; |
9fc9ab86 |
53 | is (total_size($hash), |
a52ceccd |
54 | total_size( { a => undef } ) + total_size(1) - total_size($undef), |
9fc9ab86 |
55 | 'assert hash and hash key size'); |
b1e5ad85 |
56 | |
c8db37d3 |
57 | ############################################################################# |
58 | # #24846 (Does not correctly recurse into references in a PVNV-type scalar) |
b1e5ad85 |
59 | |
c8db37d3 |
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 | |
1c566e6a |
115 | cmp_ok($element_size, '<', total_size($hash), "element < hash with one element"); |
116 | cmp_ok($element_size, '>', total_size(\[]), "PVNV + [] > [] alone"); |
c8db37d3 |
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 |
1c566e6a |
141 | cmp_ok(total_size(\[0..$size]), '<', total_size( \$hash->{a} ), "[0..size] vs. PVNV"); |
c8db37d3 |
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 |
b1e5ad85 |
166 | |
c8db37d3 |
167 | $array_size = total_size(\[0..$size, undef, undef]); |
b1e5ad85 |
168 | |
c8db37d3 |
169 | $hash->{a} = [0..$size, undef, undef]; |
170 | $element_size = total_size(\$hash->{a}); |
171 | $full_hash = total_size($hash); |
b1e5ad85 |
172 | |
c8db37d3 |
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 |
b1e5ad85 |
184 | |
c8db37d3 |
185 | $array = [ 0..$size, undef, undef ]; pop @$array; |
b1e5ad85 |
186 | |
c8db37d3 |
187 | $array_size = total_size($array); |
a52ceccd |
188 | my $scalar_size = total_size(1) * (1+$size) + total_size($undef) * 1 + $ptr_size |
c8db37d3 |
189 | + $ptr_size * ($size + 2) + total_size([]); |
190 | is ($scalar_size, $array_size, "computed right size if full array"); |
b1e5ad85 |
191 | |
c8db37d3 |
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); |
b1e5ad85 |
196 | |
c8db37d3 |
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"; |
b1e5ad85 |
203 | |
c8db37d3 |
204 | is ($full_hash, $element_size + $hash_size, 'properly handles undef/non-undef inside arrays'); |
b1e5ad85 |
205 | |
c8db37d3 |
206 | } # end for different sizes |
1d6fef94 |
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 | } |
db519f11 |
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 | } |
f3cf7e20 |
285 | |
286 | { |
287 | my $sub_size = total_size(\&cmp_array_ro); |
288 | cmp_ok($sub_size, '>=', 5120, 'subroutine is at least 5K'); |
289 | cmp_ok($sub_size, '<=', 51200, 'subroutine is no more than 50K') |
290 | or diag 'Is total_size() dragging in the entire symbol table?'; |
291 | cmp_ok(total_size(\%::), '>=', 10240, 'symbol table is at least 100K'); |
292 | } |
293 | |
294 | cmp_ok(total_size(\%Exporter::), '>', total_size(\%Exporter::Heavy::)); |