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