In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/a1c09dad0dcf10a829797ed9862b81e1b7497f18?hp=7d00a3405ca1345227668bfc2bac750590adf68f>
- Log ----------------------------------------------------------------- commit a1c09dad0dcf10a829797ed9862b81e1b7497f18 Author: Zefram <[email protected]> Date: Tue Nov 14 06:40:15 2017 +0000 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 ----------------------------------------------------------------------- Summary of changes: ext/B/B/Concise.pm | 28 ++++++++++++++++++++++++++-- ext/B/t/optree_constants.t | 35 +++++++++++++++++++++++++++++++---- ext/B/t/optree_samples.t | 4 ++-- 3 files changed, 59 insertions(+), 8 deletions(-) diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 86f7739514..a9cfb5e62f 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -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}; diff --git a/ext/B/t/optree_constants.t b/ext/B/t/optree_constants.t index 865eed1df0..c139bc2eab 100644 --- a/ext/B/t/optree_constants.t +++ b/ext/B/t/optree_constants.t @@ -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 ? ( diff --git a/ext/B/t/optree_samples.t b/ext/B/t/optree_samples.t index 4dbacdc92a..83c0128f35 100644 --- a/ext/B/t/optree_samples.t +++ b/ext/B/t/optree_samples.t @@ -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 -- Perl5 Master Repository
