Permalink
Browse files

in B::Concise, show RV target better

Especially show the identity of CVs where possible.  This is important
now that gv ops often point at a coderef rather than a glob.  Fixes [perl
  • Loading branch information...
Zefram
Zefram committed Nov 14, 2017
1 parent 7d00a34 commit a1c09dad0dcf10a829797ed9862b81e1b7497f18
Showing with 59 additions and 8 deletions.
  1. +26 −2 ext/B/B/Concise.pm
  2. +31 −4 ext/B/t/optree_constants.t
  3. +2 −2 ext/B/t/optree_samples.t
View
@@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp
use Exporter (); # use #5
our $VERSION = "1.002";
our $VERSION = "1.003";
our @ISA = qw(Exporter);
our @EXPORT_OK = qw( set_style set_style_standard add_callback
concise_subref concise_cv concise_main
@@ -30,7 +30,8 @@ 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
OPpSPLIT_ASSIGN OPpSPLIT_LEX
CVf_ANON PAD_FAKELEX_ANON PAD_FAKELEX_MULTI SVf_ROK);
CVf_ANON CVf_LEXICAL CVf_NAMED
PAD_FAKELEX_ANON PAD_FAKELEX_MULTI SVf_ROK);
my %style =
("terse" =>
@@ -741,6 +742,29 @@ sub concise_sv {
$hr->{svval} .= cstring($sv->PV);
} elsif (class($sv) eq "HV") {
$hr->{svval} .= 'HASH';
} elsif (class($sv) eq "AV") {
$hr->{svval} .= 'ARRAY';
} elsif (class($sv) eq "CV") {
if ($sv->CvFLAGS & CVf_ANON) {
$hr->{svval} .= 'CODE';
} elsif ($sv->CvFLAGS & CVf_NAMED) {
$hr->{svval} .= "&";
unless ($sv->CvFLAGS & CVf_LEXICAL) {
my $stash = $sv->STASH;
unless (class($stash) eq "SPECIAL") {
$hr->{svval} .= $stash->NAME . "::";
}
}
$hr->{svval} .= $sv->NAME_HEK;
} else {
$hr->{svval} .= "&";
$sv = $sv->GV;
my $stash = $sv->STASH;
unless (class($stash) eq "SPECIAL") {
$hr->{svval} .= $stash->NAME . "::";
}
$hr->{svval} .= $sv->SAFENAME;
}
}
$hr->{svval} = 'undef' unless defined $hr->{svval};
View
@@ -16,10 +16,21 @@ BEGIN {
use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
use Config;
plan tests => 67;
plan tests => 99;
#################################
my sub lleexx {}
sub tsub0 {}
sub tsub1 {} $tsub1 = 1;
sub t::tsub2 {}
sub t::tsub3 {} $tsub3 = 1;
{
package t;
sub tsub4 {}
sub tsub5 {} $tsub5 = 1;
}
use constant { # see also t/op/gv.t line 358
myaref => [ 1,2,3 ],
myfl => 1.414213,
@@ -31,6 +42,14 @@ use constant { # see also t/op/gv.t line 358
mysub => \&ok,
myundef => undef,
myunsub => \&nosuch,
myanonsub => sub {},
mylexsub => \&lleexx,
tsub0 => \&tsub0,
tsub1 => \&tsub1,
tsub2 => \&t::tsub2,
tsub3 => \&t::tsub3,
tsub4 => \&t::tsub4,
tsub5 => \&t::tsub5,
};
sub myyes() { 1==1 }
@@ -44,12 +63,20 @@ my $want = { # expected types, how value renders in-line, todos (maybe)
myhref => [ $RV_class, '\\\\HASH'],
pi => [ 'NV', pi ],
myglob => [ $RV_class, '\\\\' ],
mysub => [ $RV_class, '\\\\' ],
myunsub => [ $RV_class, '\\\\' ],
mysub => [ $RV_class, '\\\\&main::ok' ],
myunsub => [ $RV_class, '\\\\&main::nosuch' ],
myanonsub => [ $RV_class, '\\\\CODE' ],
mylexsub => [ $RV_class, '\\\\&lleexx' ],
tsub0 => [ $RV_class, '\\\\&main::tsub0' ],
tsub1 => [ $RV_class, '\\\\&main::tsub1' ],
tsub2 => [ $RV_class, '\\\\&t::tsub2' ],
tsub3 => [ $RV_class, '\\\\&t::tsub3' ],
tsub4 => [ $RV_class, '\\\\&t::tsub4' ],
tsub5 => [ $RV_class, '\\\\&t::tsub5' ],
# these are not inlined, at least not per BC::Concise
#myyes => [ $RV_class, ],
#myno => [ $RV_class, ],
myaref => [ $RV_class, '\\\\' ],
myaref => [ $RV_class, '\\\\ARRAY' ],
myfl => [ 'NV', myfl ],
myint => [ 'IV', myint ],
$] >= 5.011 ? (
View
@@ -574,7 +574,7 @@ checkOptree ( name => 'map $_+42, 10..20',
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 1 <;> nextstate(main 497 (eval 20):1) v
# 2 <0> pushmark s
# 3 <$> const[AV ] s
# 3 <$> const[AV ARRAY] s
# 4 <1> rv2av lKPM/1
# 5 <@> mapstart K
# 6 <|> mapwhile(other->7)[t5] K
@@ -586,7 +586,7 @@ checkOptree ( name => 'map $_+42, 10..20',
EOT_EOT
# 1 <;> nextstate(main 511 (eval 26):1) v
# 2 <0> pushmark s
# 3 <$> const(AV ) s
# 3 <$> const(AV ARRAY) s
# 4 <1> rv2av lKPM/1
# 5 <@> mapstart K
# 6 <|> mapwhile(other->7)[t4] K

0 comments on commit a1c09da

Please sign in to comment.