1#!/usr/bin/perl -w
2
3use strict;
4use Test::More tests => 20;
5use Devel::Size ':all';
6
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
28sub zwapp;
29sub swoosh($$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$);
30sub crunch {
31}
32
33my $whack_size = total_size(\&whack);
34my $zwapp_size = total_size(\&zwapp);
35my $swoosh_size = total_size(\&swoosh);
36my $crunch_size = total_size(\&crunch);
37
38cmp_ok($whack_size, '>', 0, 'CV generated at runtime has a size');
39if("$]" >= 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}
46cmp_ok(length prototype \&swoosh, '>', 0, 'prototype has a length');
47cmp_ok($swoosh_size, '>', $zwapp_size + length prototype \&swoosh,
48       'prototypes add to the size');
49cmp_ok($crunch_size, '>', $zwapp_size, 'sub bodies add to the size');
50
51my $anon_proto = sub ($$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$) {};
52my $anon_size = total_size(sub {});
53my $anon_proto_size = total_size($anon_proto);
54cmp_ok($anon_size, '>', 0, 'anonymous subroutines have a size');
55cmp_ok(length prototype $anon_proto, '>', 0, 'prototype has a length');
56cmp_ok($anon_proto_size, '>', $anon_size + length prototype $anon_proto,
57       'prototypes add to the size');
58
59SKIP: {
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
64    # This one is sane even before Dave's lexical aelemfast changes:
65    cmp_ok($aelemfast_lex, '>', $anon_size,
66	   'aelemfast for a lexical is handled correctly');
67    skip('alemfast was extended to lexicals after this perl was released', 1)
68      if $] < 5.008004;
69    cmp_ok($aelemfast, '>', $aelemfast_lex,
70	   'aelemfast for a package variable is larger');
71}
72
73my $short_pvop = total_size(sub {goto GLIT});
74my $long_pvop = total_size(sub {goto KREEK_KREEK_CLANK_CLANK});
75cmp_ok($short_pvop, '>', $anon_size, 'OPc_PVOP can be measured');
76is($long_pvop, $short_pvop + 19, 'the only size difference is the label length');
77
78sub bloop {
79    my $clunk = shift;
80    if (--$clunk > 0) {
81	bloop($clunk);
82    }
83}
84
85my $before_size = total_size(\&bloop);
86bloop(42);
87my $after_size = total_size(\&bloop);
88
89cmp_ok($after_size, '>', $before_size, 'Recursion increases the PADLIST');
90
91sub closure_with_eval {
92    my $a;
93    return sub { eval ""; $a };
94}
95
96sub closure_without_eval {
97    my $a;
98    return sub { require ""; $a };
99}
100
101if ($] > 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}
113
114sub two_lex {
115    my $a;
116    my $b;
117}
118
119sub 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
126# Aargh, re-measure it. See comment at the top of the file.
127$crunch_size = total_size(\&crunch);
128my $two_lex_size = total_size(\&two_lex);
129cmp_ok($two_lex_size, '>', $crunch_size,
130       '&two_lex is bigger than an empty sub');
131cmp_ok($two_lex_size, '<', $crunch_size + 2048,
132       '&two_lex is bigger than an empty sub by less than 2048 bytes');
133
134my $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
146cmp_ok($ode_size, '<', $two_lex_size + 768,
147       '&ode is bigger than a sub with two lexicals by less than 768 bytes');
148
149# This is a copy of the simplest multiconcat test from t/opbasic/concat.t
150# Like there, this is mostly intended for ASAN to hit:
151sub multiconcat {
152    my $s = chr 0x100;
153    my $t = "\x80" x 1024;
154    $s .= "-$t-";
155    is(length($s), 1027, "utf8 dest with non-utf8 args");
156}
157
158multiconcat();
159cmp_ok(total_size(\&multiconcat), '>', 1024,
160       "pad constant makes this at least 1K");
161