Skip to content

B::Concise - More robust BEGIN block counting #23743

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Sep 22, 2025
Merged

B::Concise - More robust BEGIN block counting #23743

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
36 changes: 17 additions & 19 deletions ext/B/B/Concise.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 );
Expand All @@ -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
Expand Down Expand Up @@ -84,6 +76,7 @@ our @callbacks; # allow external management

set_style_standard("concise");

my $begin_count;
my $curcv;
my $cop_seq_base;

Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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";
}
Expand Down Expand Up @@ -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
}
Expand Down Expand Up @@ -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 {
Expand Down Expand Up @@ -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;
Expand All @@ -387,7 +381,7 @@ sub compile {
}
}
for my $pkg (@render_packs) {
no strict 'refs'; # use #15
no strict 'refs';
concise_stashref($order, \%{$pkg.'::'});
}

Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down
Loading