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 sub zwapp;
   8 sub swoosh($$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$);
   9 sub crunch {
  10 }
  11
  12 my $whack_size = total_size(\&whack);
  13 my $zwapp_size = total_size(\&zwapp);
  14 my $swoosh_size = total_size(\&swoosh);
  15 my $crunch_size = total_size(\&crunch);
  16
  17 cmp_ok($whack_size, '>', 0, 'CV generated at runtime has a size');
  18 if("$]" >= 5.017) {
  19     cmp_ok($zwapp_size, '==', $whack_size,
  20            'CV stubbed at compiletime is the same size');
  21 } else {
  22     cmp_ok($zwapp_size, '>', $whack_size,
  23            'CV stubbed at compiletime is larger (CvOUTSIDE is set and followed)');
  24 }
  25 cmp_ok(length prototype \&swoosh, '>', 0, 'prototype has a length');
  26 cmp_ok($swoosh_size, '>', $zwapp_size + length prototype \&swoosh,
  27        'prototypes add to the size');
  28 cmp_ok($crunch_size, '>', $zwapp_size, 'sub bodies add to the size');
  29
  30 my $anon_proto = sub ($$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$) {};
  31 my $anon_size = total_size(sub {});
  32 my $anon_proto_size = total_size($anon_proto);
  33 cmp_ok($anon_size, '>', 0, 'anonymous subroutines have a size');
  34 cmp_ok(length prototype $anon_proto, '>', 0, 'prototype has a length');
  35 cmp_ok($anon_proto_size, '>', $anon_size + length prototype $anon_proto,
  36        'prototypes add to the size');
  37
  38 SKIP: {
  39     use vars '@b';
  40     my $aelemfast_lex = total_size(sub {my @a; $a[0]});
  41     my $aelemfast = total_size(sub {my @a; $b[0]});
  42
  43     # This one is sane even before Dave's lexical aelemfast changes:
  44     cmp_ok($aelemfast_lex, '>', $anon_size,
  45            'aelemfast for a lexical is handled correctly');
  46     skip('alemfast was extended to lexicals after this perl was released', 1)
  47       if $] < 5.008004;
  48     cmp_ok($aelemfast, '>', $aelemfast_lex,
  49            'aelemfast for a package variable is larger');
  50 }
  51
  52 my $short_pvop = total_size(sub {goto GLIT});
  53 my $long_pvop = total_size(sub {goto KREEK_KREEK_CLANK_CLANK});
  54 cmp_ok($short_pvop, '>', $anon_size, 'OPc_PVOP can be measured');
  55 is($long_pvop, $short_pvop + 19, 'the only size difference is the label length');
  56
  57 sub bloop {
  58     my $clunk = shift;
  59     if (--$clunk > 0) {
  60         bloop($clunk);
  61     }
  62 }
  63
  64 my $before_size = total_size(\&bloop);
  65 bloop(42);
  66 my $after_size = total_size(\&bloop);
  67
  68 cmp_ok($after_size, '>', $before_size, 'Recursion increases the PADLIST');
  69
  70 sub closure_with_eval {
  71     my $a;
  72     return sub { eval ""; $a };
  73 }
  74
  75 sub closure_without_eval {
  76     my $a;
  77     return sub { require ""; $a };
  78 }
  79
  80 if ($] > 5.017001) {
  81     # Again relying too much on the core's implementation, but while that holds,
  82     # this does test that CvOUTSIDE() is being followed.
  83     cmp_ok(total_size(closure_with_eval()), '>',
  84            total_size(closure_without_eval()) + 256,
  85            'CvOUTSIDE is now NULL on cloned closures, unless they have eval');
  86 } else {
  87     # Seems that they differ by a few bytes on 5.8.x
  88     cmp_ok(total_size(closure_with_eval()), '<=',
  89            total_size(closure_without_eval()) + 256,
  90            "CvOUTSIDE is set on all cloned closures, so these won't differ by much");
  91 }
  92
  93 sub two_lex {
  94     my $a;
  95     my $b;
  96 }
  97
  98 sub ode {
  99     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;
 100     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;
 101     # /Ode/, Arthur O'Shaughnessy, published in 1873.
 102     # Sadly all but one of the remaining versus are too long for an identifier.
 103 }
 104
 105 my $two_lex_size = total_size(\&two_lex);
 106 cmp_ok($two_lex_size, '>', $crunch_size,
 107        '&two_lex is bigger than an empty sub');
 108 cmp_ok($two_lex_size, '<', $crunch_size + 2048,
 109        '&two_lex is bigger than an empty sub by less than 2048 bytes');
 110
 111 my $ode_size = total_size(\&ode);
 112 {
 113     # Fixing this for pre-v5.18 involves solving the more general problem of
 114     # when to "recurse" into nested structures, currently bodged with
 115     # "SOME_RECURSION" and friends. :-(
 116     local $::TODO =
 117         'Devel::Size has never handled the size of names in the pad correctly'
 118         if $] < 5.017004;
 119     cmp_ok($ode_size, '>', $two_lex_size + 384,
 120            '&ode is bigger than a sub with two lexicals by least 384 bytes');
 121 }
 122
 123 cmp_ok($ode_size, '<', $two_lex_size + 768,
 124        '&ode is bigger than a sub with two lexicals by less than 768 bytes');