This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
in B::Concise, show RV target better
authorZefram <zefram@fysh.org>
Tue, 14 Nov 2017 06:40:15 +0000 (06:40 +0000)
committerZefram <zefram@fysh.org>
Tue, 14 Nov 2017 06:42:53 +0000 (06:42 +0000)
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

ext/B/B/Concise.pm
ext/B/t/optree_constants.t
ext/B/t/optree_samples.t

index 86f7739..a9cfb5e 100644 (file)
@@ -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};
index 865eed1..c139bc2 100644 (file)
@@ -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 ? (
index 4dbacdc..83c0128 100644 (file)
@@ -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