Commit | Line | Data |
0430b7f7 |
1 | #!/usr/bin/perl -w |
e98cedbf |
2 | |
78037efb |
3 | use Test::More tests => 30; |
0430b7f7 |
4 | use strict; |
6c3d85e7 |
5 | use Devel::Size qw(size total_size); |
e98cedbf |
6 | |
0430b7f7 |
7 | can_ok ('Devel::Size', qw/ |
8 | size |
9 | total_size |
10 | /); |
e98cedbf |
11 | |
5a83b7cf |
12 | die ("Uhoh, test uses an outdated version of Devel::Size") |
3cba7a2c |
13 | unless is ($Devel::Size::VERSION, '0.77_50', 'VERSION MATCHES'); |
0430b7f7 |
14 | |
15 | ############################################################################# |
16 | # some basic checks: |
e98cedbf |
17 | |
5073b933 |
18 | use vars qw($foo @foo %foo); |
19 | $foo = "12"; |
20 | @foo = (1,2,3); |
21 | %foo = (a => 1, b => 2); |
b98fcdb9 |
22 | |
23 | my $x = "A string"; |
9fc9ab86 |
24 | my $y = "A much much longer string"; # need to be at least 7 bytes longer for 64 bit |
1c566e6a |
25 | cmp_ok(size($x), '<', size($y), 'size() of strings'); |
26 | cmp_ok(total_size($x), '<', total_size($y), 'total_size() of strings'); |
b98fcdb9 |
27 | |
28 | my @x = (1..4); |
0430b7f7 |
29 | my @y = (1..200); |
30 | |
31 | my $size_1 = total_size(\@x); |
32 | my $size_2 = total_size(\@y); |
33 | |
1c566e6a |
34 | cmp_ok($size_1, '<', $size_2, 'size() of array refs'); |
0430b7f7 |
35 | |
50f7a785 |
36 | # the arrays alone shouldn't be the same size |
0430b7f7 |
37 | $size_1 = size(\@x); |
38 | $size_2 = size(\@y); |
39 | |
50f7a785 |
40 | isnt ( $size_1, $size_2, 'size() of array refs'); |
0430b7f7 |
41 | |
42 | ############################################################################# |
43 | # IV vs IV+PV (bug #17586) |
b98fcdb9 |
44 | |
0430b7f7 |
45 | $x = 12; |
46 | $y = 12; $y .= ''; |
b98fcdb9 |
47 | |
0430b7f7 |
48 | $size_1 = size($x); |
49 | $size_2 = size($y); |
b98fcdb9 |
50 | |
1c566e6a |
51 | cmp_ok($size_1, '<', $size_2, ' ."" makes string longer'); |
0430b7f7 |
52 | |
53 | ############################################################################# |
78dfb4e7 |
54 | # check that the tracking_hash is working |
55 | |
56 | my($a,$b) = (1,2); |
57 | my @ary1 = (\$a, \$a); |
58 | my @ary2 = (\$a, \$b); |
59 | |
cf1d079f |
60 | cmp_ok(total_size(\@ary1), '<', total_size(\@ary2), |
61 | 'the tracking hash is working'); |
78dfb4e7 |
62 | |
0430b7f7 |
63 | ############################################################################# |
78dfb4e7 |
64 | # check that circular references don't mess things up |
65 | |
66 | my($c1,$c2); $c2 = \$c1; $c1 = \$c2; |
67 | |
0430b7f7 |
68 | is (total_size($c1), total_size($c2), 'circular references'); |
69 | |
9fc9ab86 |
70 | ########################################################## |
71 | # RT#14849 (& RT#26781 and possibly RT#29238?) |
cf1d079f |
72 | cmp_ok( total_size( sub{ do{ my $t=0 }; } ), '>', 0, |
73 | 'total_size( sub{ my $t=0 } ) > 0' ); |
87372f42 |
74 | |
75 | # CPAN RT #58484 and #58485 |
cf1d079f |
76 | cmp_ok(total_size(\&total_size), '>', 0, 'total_size(\&total_size) > 0'); |
87372f42 |
77 | |
66f50dda |
78 | use constant LARGE => 'N' x 8192; |
87372f42 |
79 | |
66f50dda |
80 | cmp_ok (total_size(\&LARGE), '>', 8192, |
81 | 'total_size for a constant includes the constant'); |
2640cff1 |
82 | |
83 | { |
84 | my $a = []; |
85 | my $b = \$a; |
d6158a76 |
86 | # Scalar::Util isn't in the core before 5.7.something. |
87 | # The test isn't really testing anything without the weaken(), but it |
88 | # isn't counter-productive or harmful to run it anyway. |
89 | unless (eval { |
90 | require Scalar::Util; |
91 | # making a weakref upgrades the target to PVMG and adds magic |
92 | Scalar::Util::weaken($b); |
93 | 1; |
94 | }) { |
95 | die $@ if $] >= 5.008; |
96 | } |
97 | |
8c394e12 |
98 | is(total_size($a), total_size([]), |
99 | 'Any intial reference is dereferenced and discarded'); |
2640cff1 |
100 | } |
a52ceccd |
101 | |
102 | # Must call direct - avoid all copying: |
103 | foreach(['undef', total_size(undef)], |
104 | ['no', total_size(1 == 0)], |
105 | ['yes', total_size(1 == 1)], |
106 | ) { |
107 | my ($name, $size) = @$_; |
108 | is($size, 0, |
109 | "PL_sv_$name is interpeter wide, so not counted as part of the structure's size"); |
110 | } |
95dc1714 |
111 | |
112 | { |
113 | # SvOOK stuff |
114 | my $uurk = "Perl Rules"; |
115 | # This may upgrade the scalar: |
116 | $uurk =~ s/Perl//; |
117 | $uurk =~ s/^/Perl/; |
118 | my $before_size = total_size($uurk); |
119 | my $before_length = length $uurk; |
120 | cmp_ok($before_size, '>', $before_length, 'Size before is sane'); |
121 | $uurk =~ s/Perl //; |
122 | is(total_size($uurk), $before_size, |
123 | "Size doesn't change because OOK is used"); |
124 | cmp_ok(length $uurk, '<', $before_size, 'but string is shorter'); |
125 | } |
924d9c4e |
126 | |
127 | sub shared_hash_keys { |
128 | my %h = @_; |
129 | my $one = total_size([keys %h]); |
130 | cmp_ok($one, '>', 0, 'Size of one entry is sane'); |
131 | my $two = total_size([keys %h, keys %h]); |
132 | cmp_ok($two, '>', $one, 'Two take more space than one'); |
133 | my $increment = $two - $one; |
134 | is(total_size([keys %h, keys %h, keys %h]), $one + 2 * $increment, |
135 | 'Linear size increase for three'); |
136 | return $increment; |
137 | } |
138 | |
139 | { |
140 | my $small = shared_hash_keys(Perl => 'Rules'); |
141 | my $big = shared_hash_keys('x' x 1024, ''); |
142 | SKIP: { |
143 | skip("[keys %h] doesn't copy as shared hash key scalars prior to 5.10.0", |
144 | 1) if $] < 5.010; |
145 | is ($small, $big, 'The "shared" part of shared hash keys is spotted'); |
146 | } |
147 | } |
78037efb |
148 | |
149 | { |
150 | use vars '%DANG_DANG_DANG_DANG_DANG_DANG_DANG_DANG_DANG'; |
151 | my $hash_size = total_size(\%DANG_DANG_DANG_DANG_DANG_DANG_DANG_DANG_DANG); |
152 | cmp_ok($hash_size, '>', 0, 'Hash size is sane'); |
153 | my $stash_size |
154 | = total_size(\%DANG_DANG_DANG_DANG_DANG_DANG_DANG_DANG_DANG::); |
155 | cmp_ok($stash_size, '>', |
156 | $hash_size + length 'DANG_DANG_DANG_DANG_DANG_DANG_DANG_DANG_DANG', |
157 | 'Stash size is larger than hash size plus length of the name'); |
158 | } |
159 | |
160 | { |
161 | my %h = (Perl => 'Rules'); |
162 | my $hash_size = total_size(\%h); |
163 | cmp_ok($hash_size, '>', 0, 'Hash size is sane'); |
164 | my $a = keys %h; |
165 | if ($] < 5.010) { |
166 | is(total_size(\%h), $hash_size, |
167 | "Creating iteration state doesn't need to allocate storage"); |
168 | # because all hashes carry the overhead of this storage from creation |
169 | } else { |
170 | cmp_ok(total_size(\%h), '>', $hash_size, |
171 | 'Creating iteration state allocates storage'); |
172 | } |
173 | } |