5 # I'm not sure if this is "too hacky to live".
6 # It seems that for some newer versions of Test::More on older perls, if the
7 # test for total_size(1 == 1) is *after* the load of test more, then the test
8 # fails. I infer that something in Test::More is also ending up with PL_sv_yes
9 # in a pad temp somewhere, and whatever gets compiled first gets to keep the
10 # real one, and everyone afterwards gets forced to have a copy. (For ithreads).
11 # And I'm not even sure if this is a bug that was fixed (in the constant code)
12 # or a necessary evil that survives, and it's pure chance when it hits.
14 # Must call direct - avoid all copying:
15 foreach(['undef', total_size(undef)],
16 ['no', total_size(1 == 0)],
17 ['yes', total_size(1 == 1)],
19 my ($name, $size) = @$_;
21 "PL_sv_$name is interpeter wide, so not counted as part of the structure's size");
25 use Test::More tests => 30;
26 use Devel::Size qw(size total_size);
28 can_ok ('Devel::Size', qw/
33 die ("Uhoh, test uses an outdated version of Devel::Size")
34 unless is ($Devel::Size::VERSION, '0.81', 'VERSION MATCHES');
36 #############################################################################
39 use vars qw($foo @foo %foo);
42 %foo = (a => 1, b => 2);
45 my $y = "A much much longer string"; # need to be at least 7 bytes longer for 64 bit
46 cmp_ok(size($x), '<', size($y), 'size() of strings');
47 cmp_ok(total_size($x), '<', total_size($y), 'total_size() of strings');
52 my $size_1 = total_size(\@x);
53 my $size_2 = total_size(\@y);
55 cmp_ok($size_1, '<', $size_2, 'size() of array refs');
57 # the arrays alone shouldn't be the same size
61 isnt ( $size_1, $size_2, 'size() of array refs');
63 #############################################################################
64 # IV vs IV+PV (bug #17586)
72 cmp_ok($size_1, '<', $size_2, ' ."" makes string longer');
74 #############################################################################
75 # check that the tracking_hash is working
78 my @ary1 = (\$a, \$a);
79 my @ary2 = (\$a, \$b);
81 cmp_ok(total_size(\@ary1), '<', total_size(\@ary2),
82 'the tracking hash is working');
84 #############################################################################
85 # check that circular references don't mess things up
87 my($c1,$c2); $c2 = \$c1; $c1 = \$c2;
89 is (total_size($c1), total_size($c2), 'circular references');
91 ##########################################################
92 # RT#14849 (& RT#26781 and possibly RT#29238?)
93 cmp_ok( total_size( sub{ do{ my $t=0 }; } ), '>', 0,
94 'total_size( sub{ my $t=0 } ) > 0' );
96 # CPAN RT #58484 and #58485
97 cmp_ok(total_size(\&total_size), '>', 0, 'total_size(\&total_size) > 0');
99 use constant LARGE => 'N' x 8192;
101 cmp_ok (total_size(\&LARGE), '>', 8192,
102 'total_size for a constant includes the constant');
107 # Scalar::Util isn't in the core before 5.7.something.
108 # The test isn't really testing anything without the weaken(), but it
109 # isn't counter-productive or harmful to run it anyway.
111 require Scalar::Util;
112 # making a weakref upgrades the target to PVMG and adds magic
113 Scalar::Util::weaken($b);
116 die $@ if $] >= 5.008;
119 is(total_size($a), total_size([]),
120 'Any intial reference is dereferenced and discarded');
127 my $uurk = "Perl Rules";
128 # This may upgrade the scalar:
131 my $before_size = total_size($uurk);
132 my $before_length = length $uurk;
133 cmp_ok($before_size, '>', $before_length, 'Size before is sane');
134 # As of 5.20.0, s/// doesn't trigger COW.
135 # Seems that formline is about the the only thing left that reliably calls
136 # sv_chop. See CPAN #95493, perl #122322
137 formline '^<<<<~', $uurk;
138 is(total_size($uurk), $before_size,
139 "Size doesn't change because OOK is used");
140 cmp_ok(length $uurk, '<', $before_size, 'but string is shorter');
143 sub shared_hash_keys {
145 my $one = total_size([keys %h]);
146 cmp_ok($one, '>', 0, 'Size of one entry is sane');
147 my $two = total_size([keys %h, keys %h]);
148 cmp_ok($two, '>', $one, 'Two take more space than one');
149 my $increment = $two - $one;
150 is(total_size([keys %h, keys %h, keys %h]), $one + 2 * $increment,
151 'Linear size increase for three');
156 my $small = shared_hash_keys(Perl => 'Rules');
157 my $big = shared_hash_keys('x' x 1024, '');
159 skip("[keys %h] doesn't copy as shared hash key scalars prior to 5.10.0",
161 is ($small, $big, 'The "shared" part of shared hash keys is spotted');
166 use vars '%DANG_DANG_DANG_DANG_DANG_DANG_DANG_DANG_DANG';
167 my $hash_size = total_size(\%DANG_DANG_DANG_DANG_DANG_DANG_DANG_DANG_DANG);
168 cmp_ok($hash_size, '>', 0, 'Hash size is sane');
170 = total_size(\%DANG_DANG_DANG_DANG_DANG_DANG_DANG_DANG_DANG::);
171 cmp_ok($stash_size, '>',
172 $hash_size + length 'DANG_DANG_DANG_DANG_DANG_DANG_DANG_DANG_DANG',
173 'Stash size is larger than hash size plus length of the name');
177 my %h = (Perl => 'Rules');
178 my $hash_size = total_size(\%h);
179 cmp_ok($hash_size, '>', 0, 'Hash size is sane');
182 is(total_size(\%h), $hash_size,
183 "Creating iteration state doesn't need to allocate storage");
184 # because all hashes carry the overhead of this storage from creation
186 cmp_ok(total_size(\%h), '>', $hash_size,
187 'Creating iteration state allocates storage');