t/code.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Test::More tests => 18;
   5 use 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
  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');
  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 }
  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');
  58
  59 SKIP: {
  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
  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');
  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');
  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 }
 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
 126 # Aargh, re-measure it. See comment at the top of the file.
 127 $crunch_size = total_size(\&crunch);
 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');