Commit | Line | Data |
57fcdb5b |
1 | #!/usr/bin/perl -w |
2 | |
3 | use strict; |
ee01612f |
4 | use Test::More tests => 18; |
57fcdb5b |
5 | use Devel::Size ':all'; |
6 | |
13a207d7 |
7 | # For me, for some files locally, I'm seeing failures |
8 | # Failed test '&two_lex is bigger than an empty sub by less than 2048 bytes' |
9 | # Just for some perl versions (5.8.7, 5.10.1, some 5.12.*) |
10 | # As ever, the reason is subtle and annoying. As this test is running in package |
11 | # main, loading modules at runtime might create entries in %:: |
12 | # In this case, it's just one key, '_</.../lib/perl5/5.12.4/overload.pm' |
13 | # because Test::More is demand loading overload at the first test. |
14 | # So the first fix I tried was to "encourage" Test::More to get all this done |
15 | # before we start doing things that are sensitive to the size of %:: |
16 | # with this: |
17 | # |
18 | # cmp_ok(1, '==', 1, "prompt Test::More to load everything it needs *now*"); |
19 | # |
20 | # which fixed most things, but not 5.8.7, which (*only under make test*) would |
21 | # fail '&two_lex is bigger than an empty sub by less than 2048 bytes' |
22 | # Turns out that Test::More 0.54 creates an entry in %:: for every test run |
23 | # (not sure why, side effect of an eval with a #line directive, maybe?) |
24 | # The solution is to measure (and re-measure) the size of things you're |
25 | # comparing as contiguous statements, assigning to variables, and then make |
26 | # calls to Test::More functions. |
27 | |
57fcdb5b |
28 | sub zwapp; |
29 | sub swoosh($$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$); |
30 | sub crunch { |
31 | } |
32 | |
33 | my $whack_size = total_size(\&whack); |
34 | my $zwapp_size = total_size(\&zwapp); |
35 | my $swoosh_size = total_size(\&swoosh); |
36 | my $crunch_size = total_size(\&crunch); |
37 | |
38 | cmp_ok($whack_size, '>', 0, 'CV generated at runtime has a size'); |
75510c88 |
39 | if("$]" >= 5.017) { |
40 | cmp_ok($zwapp_size, '==', $whack_size, |
41 | 'CV stubbed at compiletime is the same size'); |
42 | } else { |
43 | cmp_ok($zwapp_size, '>', $whack_size, |
44 | 'CV stubbed at compiletime is larger (CvOUTSIDE is set and followed)'); |
45 | } |
57fcdb5b |
46 | cmp_ok(length prototype \&swoosh, '>', 0, 'prototype has a length'); |
47 | cmp_ok($swoosh_size, '>', $zwapp_size + length prototype \&swoosh, |
48 | 'prototypes add to the size'); |
49 | cmp_ok($crunch_size, '>', $zwapp_size, 'sub bodies add to the size'); |
50 | |
51 | my $anon_proto = sub ($$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$) {}; |
52 | my $anon_size = total_size(sub {}); |
53 | my $anon_proto_size = total_size($anon_proto); |
54 | cmp_ok($anon_size, '>', 0, 'anonymous subroutines have a size'); |
55 | cmp_ok(length prototype $anon_proto, '>', 0, 'prototype has a length'); |
56 | cmp_ok($anon_proto_size, '>', $anon_size + length prototype $anon_proto, |
57 | 'prototypes add to the size'); |
574d9fd9 |
58 | |
4c229154 |
59 | SKIP: { |
574d9fd9 |
60 | use vars '@b'; |
61 | my $aelemfast_lex = total_size(sub {my @a; $a[0]}); |
62 | my $aelemfast = total_size(sub {my @a; $b[0]}); |
63 | |
4c229154 |
64 | # This one is sane even before Dave's lexical aelemfast changes: |
574d9fd9 |
65 | cmp_ok($aelemfast_lex, '>', $anon_size, |
66 | 'aelemfast for a lexical is handled correctly'); |
4c229154 |
67 | skip('alemfast was extended to lexicals after this perl was released', 1) |
68 | if $] < 5.008004; |
574d9fd9 |
69 | cmp_ok($aelemfast, '>', $aelemfast_lex, |
70 | 'aelemfast for a package variable is larger'); |
71 | } |
219b7d34 |
72 | |
73 | my $short_pvop = total_size(sub {goto GLIT}); |
74 | my $long_pvop = total_size(sub {goto KREEK_KREEK_CLANK_CLANK}); |
75 | cmp_ok($short_pvop, '>', $anon_size, 'OPc_PVOP can be measured'); |
76 | is($long_pvop, $short_pvop + 19, 'the only size difference is the label length'); |
49a07034 |
77 | |
78 | sub bloop { |
79 | my $clunk = shift; |
80 | if (--$clunk > 0) { |
81 | bloop($clunk); |
82 | } |
83 | } |
84 | |
85 | my $before_size = total_size(\&bloop); |
86 | bloop(42); |
87 | my $after_size = total_size(\&bloop); |
88 | |
89 | cmp_ok($after_size, '>', $before_size, 'Recursion increases the PADLIST'); |
1606314d |
90 | |
91 | sub closure_with_eval { |
92 | my $a; |
93 | return sub { eval ""; $a }; |
94 | } |
95 | |
96 | sub closure_without_eval { |
97 | my $a; |
98 | return sub { require ""; $a }; |
99 | } |
100 | |
101 | if ($] > 5.017001) { |
102 | # Again relying too much on the core's implementation, but while that holds, |
103 | # this does test that CvOUTSIDE() is being followed. |
104 | cmp_ok(total_size(closure_with_eval()), '>', |
105 | total_size(closure_without_eval()) + 256, |
106 | 'CvOUTSIDE is now NULL on cloned closures, unless they have eval'); |
107 | } else { |
108 | # Seems that they differ by a few bytes on 5.8.x |
109 | cmp_ok(total_size(closure_with_eval()), '<=', |
110 | total_size(closure_without_eval()) + 256, |
111 | "CvOUTSIDE is set on all cloned closures, so these won't differ by much"); |
112 | } |
ee01612f |
113 | |
114 | sub two_lex { |
115 | my $a; |
116 | my $b; |
117 | } |
118 | |
119 | sub ode { |
120 | my $We_are_the_music_makers_And_we_are_the_dreamers_of_dreams_Wandering_by_lone_sea_breakers_And_sitting_by_desolate_streams_World_losers_and_world_forsakers_On_whom_the_pale_moon_gleams_Yet_we_are_the_movers_and_shakers_Of_the_world_for_ever_it_seems; |
121 | my $With_wonderful_deathless_ditties_We_build_up_the_world_s_great_cities_And_out_of_a_fabulous_story_We_fashion_an_empire_s_glory_One_man_with_a_dream_at_pleasure_Shall_go_forth_and_conquer_a_crown_And_three_with_a_new_song_s_measure; |
122 | # /Ode/, Arthur O'Shaughnessy, published in 1873. |
123 | # Sadly all but one of the remaining versus are too long for an identifier. |
124 | } |
125 | |
13a207d7 |
126 | # Aargh, re-measure it. See comment at the top of the file. |
127 | $crunch_size = total_size(\&crunch); |
ee01612f |
128 | my $two_lex_size = total_size(\&two_lex); |
129 | cmp_ok($two_lex_size, '>', $crunch_size, |
130 | '&two_lex is bigger than an empty sub'); |
131 | cmp_ok($two_lex_size, '<', $crunch_size + 2048, |
132 | '&two_lex is bigger than an empty sub by less than 2048 bytes'); |
133 | |
134 | my $ode_size = total_size(\&ode); |
135 | { |
136 | # Fixing this for pre-v5.18 involves solving the more general problem of |
137 | # when to "recurse" into nested structures, currently bodged with |
138 | # "SOME_RECURSION" and friends. :-( |
139 | local $::TODO = |
140 | 'Devel::Size has never handled the size of names in the pad correctly' |
141 | if $] < 5.017004; |
142 | cmp_ok($ode_size, '>', $two_lex_size + 384, |
143 | '&ode is bigger than a sub with two lexicals by least 384 bytes'); |
144 | } |
145 | |
146 | cmp_ok($ode_size, '<', $two_lex_size + 768, |
147 | '&ode is bigger than a sub with two lexicals by less than 768 bytes'); |