diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index f3aee03e9986..0e4133798420 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -3,18 +3,12 @@ package B::Concise; # This program is free software; you can redistribute and/or modify it # under the same terms as Perl itself. -# Note: we need to keep track of how many use declarations/BEGIN -# blocks this module uses, so we can avoid printing them when user -# asks for the BEGIN blocks in her program. Update the comments and -# the count in concise_specials if you add or delete one. The -# -MO=Concise counts as use #1. +use strict; +use warnings; -use strict; # use #2 -use warnings; # use #3 +use Exporter 'import'; -use Exporter 'import'; # uses #4-6, since Exporter does use strict, no strict - -our $VERSION = "1.008"; +our $VERSION = "1.009"; our @EXPORT_OK = qw( set_style set_style_standard add_callback concise_subref concise_cv concise_main add_style walk_output compile reset_sequence ); @@ -24,8 +18,6 @@ our %EXPORT_TAGS = cb => [qw( add_callback )], mech => [qw( concise_subref concise_cv concise_main )], ); -# uses #7-10, since B->import loads Exporter::Heavy which does use strict, -# no strict, no warnings. use B qw(class ppname main_start main_root main_cv cstring svref_2object SVf_IOK SVf_NOK SVf_POK SVf_IVisUV SVf_FAKE OPf_KIDS OPf_SPECIAL OPf_STACKED @@ -84,6 +76,7 @@ our @callbacks; # allow external management set_style_standard("concise"); +my $begin_count; my $curcv; my $cop_seq_base; @@ -114,7 +107,7 @@ sub add_callback { # output handle, used with all Concise-output printing our $walkHandle; # public for your convenience -BEGIN { $walkHandle = \*STDOUT } # use #11 +BEGIN { $walkHandle = \*STDOUT } sub walk_output { # updates $walkHandle my $handle = shift; @@ -180,7 +173,7 @@ sub concise_cv_obj { return; } if (class($cv->START) eq "NULL") { - no strict 'refs'; # use #12 + no strict 'refs'; if (ref $name eq 'CODE') { print $walkHandle "coderef $name has no START\n"; } @@ -229,8 +222,9 @@ sub concise_main { sub concise_specials { my($name, $order, @cv_s) = @_; my $i = 1; + if ($name eq "BEGIN") { - splice(@cv_s, 0, 16); # skip 16 BEGIN blocks from this file + splice(@cv_s, 0, $begin_count); # skip our BEGIN blocks from this file } elsif ($name eq "CHECK") { pop @cv_s; # skip the CHECK block that calls us } @@ -302,7 +296,7 @@ sub compileOpts { } elsif ($o =~ /^-stash=(.*)/) { my $pkg = $1; - no strict 'refs'; # use #13 + no strict 'refs'; if (! %{$pkg.'::'}) { eval "require $pkg"; } else { @@ -367,7 +361,7 @@ sub compile { next; } else { $objname = "main::" . $objname unless $objname =~ /::/; - no strict 'refs'; # use #14 + no strict 'refs'; my $glob = \*$objname; unless (*$glob{CODE} || *$glob{FORMAT}) { print $walkHandle "$objname:\n" if $banner; @@ -387,7 +381,7 @@ sub compile { } } for my $pkg (@render_packs) { - no strict 'refs'; # use #15 + no strict 'refs'; concise_stashref($order, \%{$pkg.'::'}); } @@ -407,7 +401,7 @@ my %opclass = ('OP' => "0", 'UNOP' => "1", 'BINOP' => "2", 'LOGOP' => "|", 'PVOP' => '"', 'LOOP' => "{", 'COP' => ";", 'PADOP' => "#", 'METHOP' => '.', UNOP_AUX => '+'); -no warnings 'qw'; # "Possible attempt to put comments..."; use #16 +no warnings 'qw'; # "Possible attempt to put comments..." my @linenoise = qw'# () sc ( @? 1 $* gv *{ m$ m@ m% m? p/ *$ $ $# & a& pt \\ s\\ rf bl ` *? <> ?? ?/ r/ c/ // qr s/ /c y/ = @= C sC Cp sp df un BM po +1 +I @@ -1088,6 +1082,10 @@ sub tree { map(" " x (length($name)+$size) . $_, @lines)); } +# Count how many BEGIN blocks have been used to avoid printing them when a +# user asks for the BEGIN blocks in their program. Must be our last BEGIN. +BEGIN { $begin_count =()= B::begin_av->isa('B::AV') ? B::begin_av->ARRAY : () } + # *** Warning: fragile kludge ahead *** # Because the B::* modules run in the same interpreter as the code # they're compiling, their presence tends to distort the view we have of