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 | |
24 | plan(tests => 16 + 4 *12 + 2 * scalar keys %types); |
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 | |
b1e5ad85 |
43 | my $hash = {}; |
c8db37d3 |
44 | $hash->{a} = 1; |
9fc9ab86 |
45 | is (total_size($hash), |
46 | total_size( { a => undef } ) + total_size(1) - total_size(undef), |
47 | 'assert hash and hash key size'); |
b1e5ad85 |
48 | |
c8db37d3 |
49 | ############################################################################# |
50 | # #24846 (Does not correctly recurse into references in a PVNV-type scalar) |
b1e5ad85 |
51 | |
c8db37d3 |
52 | # run the following tests with different sizes |
53 | |
54 | for my $size (2, 3, 7, 100) |
55 | { |
56 | my $hash = { a => 1 }; |
57 | |
58 | # hash + key minus the value |
59 | my $hash_size = total_size($hash) - total_size(1); |
60 | |
61 | $hash->{a} = 0/1; |
62 | $hash->{a} = []; |
63 | |
64 | my $pvnv_size = total_size(\$hash->{a}) - total_size([]); |
65 | # size of one ref |
66 | my $ref_size = total_size(\\1) - total_size(1); |
67 | |
68 | # $hash->{a} is now a PVNV, e.g. a scalar NV and a ref to an array: |
69 | # SV = PVNV(0x81ff9a8) at 0x8170d48 |
70 | # REFCNT = 1 |
71 | # FLAGS = (ROK) |
72 | # IV = 0 |
73 | # NV = 0 |
74 | # RV = 0x81717bc |
75 | # SV = PVAV(0x8175d6c) at 0x81717bc |
76 | # REFCNT = 1 |
77 | # FLAGS = () |
78 | # IV = 0 |
79 | # NV = 0 |
80 | # ARRAY = 0x0 |
81 | # FILL = -1 |
82 | # MAX = -1 |
83 | # ARYLEN = 0x0 |
84 | # FLAGS = (REAL) |
85 | # PV = 0x81717bc "" |
86 | # CUR = 0 |
87 | # LEN = 0 |
88 | |
89 | # Compare this to a plain array ref |
90 | #SV = RV(0x81a2834) at 0x8207a2c |
91 | # REFCNT = 1 |
92 | # FLAGS = (TEMP,ROK) |
93 | # RV = 0x8170b44 |
94 | # SV = PVAV(0x8175d98) at 0x8170b44 |
95 | # REFCNT = 2 |
96 | # FLAGS = () |
97 | # IV = 0 |
98 | # NV = 0 |
99 | # ARRAY = 0x0 |
100 | # FILL = -1 |
101 | # MAX = -1 |
102 | # ARYLEN = 0x0 |
103 | |
104 | # Get the size of the PVNV and the contained array |
105 | my $element_size = total_size(\$hash->{a}); |
106 | |
1c566e6a |
107 | cmp_ok($element_size, '<', total_size($hash), "element < hash with one element"); |
108 | cmp_ok($element_size, '>', total_size(\[]), "PVNV + [] > [] alone"); |
c8db37d3 |
109 | |
110 | # Dereferencing the PVNV (the argument to total_size) leaves us with |
111 | # just the array, and this should be equal to a dereferenced array: |
112 | is (total_size($hash->{a}), total_size([]), '[] vs. []'); |
113 | |
114 | # the hash with one key |
115 | # the PVNV in the hash |
116 | # the RV inside the PVNV |
117 | # the contents of the array (array size) |
118 | |
119 | my $full_hash = total_size($hash); |
120 | my $array_size = total_size([]); |
121 | is ($full_hash, $element_size + $hash_size, 'properly recurses into PVNV'); |
122 | is ($full_hash, $array_size + $pvnv_size + $hash_size, 'properly recurses into PVNV'); |
123 | |
124 | $hash->{a} = [0..$size]; |
125 | |
126 | # the outer references stripped away, so they should be the same |
127 | is (total_size([0..$size]), total_size( $hash->{a} ), "hash element vs. array"); |
128 | |
129 | # the outer references included, one is just a normal ref, while the other |
130 | # is a PVNV, so they shouldn't be the same: |
131 | isnt (total_size(\[0..$size]), total_size( \$hash->{a} ), "[0..size] vs PVNV"); |
132 | # and the plain ref should be smaller |
1c566e6a |
133 | cmp_ok(total_size(\[0..$size]), '<', total_size( \$hash->{a} ), "[0..size] vs. PVNV"); |
c8db37d3 |
134 | |
135 | $full_hash = total_size($hash); |
136 | $element_size = total_size(\$hash->{a}); |
137 | $array_size = total_size(\[0..$size]); |
138 | |
139 | print "# full_hash = $full_hash\n"; |
140 | print "# hash_size = $hash_size\n"; |
141 | print "# array size: $array_size\n"; |
142 | print "# element size: $element_size\n"; |
143 | print "# ref_size = $ref_size\n"; |
144 | print "# pvnv_size: $pvnv_size\n"; |
145 | |
146 | # the total size is: |
147 | |
148 | # the hash with one key |
149 | # the PVNV in the hash |
150 | # the RV inside the PVNV |
151 | # the contents of the array (array size) |
152 | |
153 | is ($full_hash, $element_size + $hash_size, 'properly recurses into PVNV'); |
154 | # is ($full_hash, $array_size + $pvnv_size + $hash_size, 'properly recurses into PVNV'); |
155 | |
156 | ############################################################################# |
157 | # repeat the former test, but mix in some undef elements |
b1e5ad85 |
158 | |
c8db37d3 |
159 | $array_size = total_size(\[0..$size, undef, undef]); |
b1e5ad85 |
160 | |
c8db37d3 |
161 | $hash->{a} = [0..$size, undef, undef]; |
162 | $element_size = total_size(\$hash->{a}); |
163 | $full_hash = total_size($hash); |
b1e5ad85 |
164 | |
c8db37d3 |
165 | print "# full_hash = $full_hash\n"; |
166 | print "# hash_size = $hash_size\n"; |
167 | print "# array size: $array_size\n"; |
168 | print "# element size: $element_size\n"; |
169 | print "# ref_size = $ref_size\n"; |
170 | print "# pvnv_size: $pvnv_size\n"; |
171 | |
172 | is ($full_hash, $element_size + $hash_size, 'properly recurses into PVNV'); |
173 | |
174 | ############################################################################# |
175 | # repeat the former test, but use a pre-extended array |
b1e5ad85 |
176 | |
c8db37d3 |
177 | $array = [ 0..$size, undef, undef ]; pop @$array; |
b1e5ad85 |
178 | |
c8db37d3 |
179 | $array_size = total_size($array); |
180 | my $scalar_size = total_size(1) * (1+$size) + total_size(undef) * 1 + $ptr_size |
181 | + $ptr_size * ($size + 2) + total_size([]); |
182 | is ($scalar_size, $array_size, "computed right size if full array"); |
b1e5ad85 |
183 | |
c8db37d3 |
184 | $hash->{a} = [0..$size, undef, undef]; pop @{$hash->{a}}; |
185 | $full_hash = total_size($hash); |
186 | $element_size = total_size(\$hash->{a}); |
187 | $array_size = total_size(\$array); |
b1e5ad85 |
188 | |
c8db37d3 |
189 | print "# full_hash = $full_hash\n"; |
190 | print "# hash_size = $hash_size\n"; |
191 | print "# array size: $array_size\n"; |
192 | print "# element size: $element_size\n"; |
193 | print "# ref_size = $ref_size\n"; |
194 | print "# pvnv_size: $pvnv_size\n"; |
b1e5ad85 |
195 | |
c8db37d3 |
196 | is ($full_hash, $element_size + $hash_size, 'properly handles undef/non-undef inside arrays'); |
b1e5ad85 |
197 | |
c8db37d3 |
198 | } # end for different sizes |
1d6fef94 |
199 | |
200 | sub cmp_array_ro { |
201 | my($got, $want, $desc) = @_; |
202 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
203 | is(@$got, @$want, "$desc (same element count)"); |
204 | my $i = @$want; |
205 | while ($i--) { |
206 | is($got->[$i], $want->[$i], "$desc (element $i)"); |
207 | } |
208 | } |
209 | |
210 | { |
211 | my $undef; |
212 | my $undef_size = total_size($undef); |
213 | cmp_ok($undef_size, '>', 0, 'non-zero size for NULL'); |
214 | |
215 | my $iv_size = total_size(1); |
216 | cmp_ok($iv_size, '>', 0, 'non-zero size for IV'); |
217 | |
218 | # Force the array to allocate storage for elements. |
219 | # This avoids making the assumption that just because it doesn't happen |
220 | # initially now, it won't stay that way forever. |
221 | my @array = 42; |
222 | my $array_1_size = total_size(\@array); |
223 | cmp_ok($array_1_size, '>', 0, 'non-zero size for array with 1 element'); |
224 | |
225 | $array[2] = 6 * 9; |
226 | |
227 | my @copy = @array; |
228 | |
229 | # This might be making too many assumptions about the current implementation |
230 | my $array_2_size = total_size(\@array); |
231 | is($array_2_size, $array_1_size + $iv_size, |
232 | "gaps in arrays don't allocate scalars"); |
233 | |
234 | # Avoid using is_deeply() as that will read $#array, which is a write |
235 | # action prior to 5.12. (Different writes on 5.10 and 5.8-and-earlier, but |
236 | # a write either way, allocating memory. |
237 | cmp_array_ro(\@array, \@copy, 'two arrays compare the same'); |
238 | |
239 | # A write action: |
240 | $array[1] = undef; |
241 | |
242 | is(total_size(\@array), $array_2_size + $undef_size, |
243 | "assigning undef to a gap in an array allocates a scalar"); |
244 | |
245 | cmp_array_ro(\@array, \@copy, 'two arrays compare the same'); |
246 | } |
db519f11 |
247 | |
248 | { |
249 | my %sizes; |
250 | # reverse sort ensures that PVIV, PVNV and RV are processed before |
251 | # IV, NULL, or NV :-) |
252 | foreach my $type (reverse sort keys %types) { |
253 | # Need to make sure this goes in a new scalar every time. Putting it |
254 | # directly in a lexical means that it's in the pad, and the pad recycles |
255 | # scalars, a side effect of which is that they get upgraded in ways we |
256 | # don't really want |
257 | my $a; |
258 | $a->[0] = $types{$type}; |
259 | undef $a->[0]; |
260 | |
261 | my $expect = $sizes{$type} = size(\$a->[0]); |
262 | |
263 | $a->[0] = \('x' x 1024); |
264 | |
265 | $expect = $sizes{RV} if $type eq 'NULL'; |
266 | $expect = $sizes{PVNV} if $type eq 'NV'; |
267 | $expect = $sizes{PVIV} if $type eq 'IV' && $] < 5.012; |
268 | |
269 | # Remember, size() removes a level of referencing if present. So add |
270 | # one, so that we get the size of our reference: |
271 | is(size(\$a->[0]), $expect, |
272 | "Type $type containing a reference, size() does not recurse to the referent"); |
273 | cmp_ok(total_size(\$a->[0]), '>', 1024, |
274 | "Type $type, total_size() recurses to the referent"); |
275 | } |
276 | } |