This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Concise.pm: extract padname code and fixup split
authorDavid Mitchell <davem@iabyn.com>
Mon, 19 Sep 2016 15:42:45 +0000 (16:42 +0100)
committerDavid Mitchell <davem@iabyn.com>
Tue, 4 Oct 2016 10:18:40 +0000 (11:18 +0100)
The code that prints '$i:1,2'' in something like 'padsv[$i:1,2]':
extract it out into a separate function, then use it with  split
to display the array name rather than just a target number in:

    $ perl -MO=Concise -e'my @a = split()'
    ...
    split(/" "/ => @a:1,2)[t2] vK/LVINTRO,RTIME,ASSIGN,LEX,IMPLIM ->6

ext/B/B/Concise.pm

index d525b5f..315e00a 100644 (file)
@@ -764,6 +764,50 @@ sub fill_srclines {
     $srclines{$fullnm} = \@l;
 }
 
+# Given a pad target, return the pad var's name and cop range /
+# fakeness, or failing that, its target number.
+# e.g.
+#   ('$i', '$i:5,7')
+# or
+#   ('$i', '$i:fake:a')
+# or
+#   ('t5', 't5')
+
+sub padname {
+    my ($targ) = @_;
+
+    my ($targarg, $targarglife);
+    my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$targ];
+    if (defined $padname and class($padname) ne "SPECIAL" and
+        $padname->LEN)
+    {
+        $targarg  = $padname->PVX;
+        if ($padname->FLAGS & SVf_FAKE) {
+            # These changes relate to the jumbo closure fix.
+            # See changes 19939 and 20005
+            my $fake = '';
+            $fake .= 'a'
+                if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_ANON;
+            $fake .= 'm'
+                if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_MULTI;
+            $fake .= ':' . $padname->PARENT_PAD_INDEX
+                if $curcv->CvFLAGS & CVf_ANON;
+            $targarglife = "$targarg:FAKE:$fake";
+        }
+        else {
+            my $intro = $padname->COP_SEQ_RANGE_LOW - $cop_seq_base;
+            my $finish = int($padname->COP_SEQ_RANGE_HIGH) - $cop_seq_base;
+            $finish = "end" if $finish == 999999999 - $cop_seq_base;
+            $targarglife = "$targarg:$intro,$finish";
+        }
+    } else {
+        $targarglife = $targarg = "t" . $targ;
+    }
+    return $targarg, $targarglife;
+}
+
+
+
 sub concise_op {
     my ($op, $level, $format) = @_;
     my %h;
@@ -796,33 +840,7 @@ sub concise_op {
             : 1;
        my (@targarg, @targarglife);
        for my $i (0..$count-1) {
-           my ($targarg, $targarglife);
-           my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}+$i];
-           if (defined $padname and class($padname) ne "SPECIAL" and
-               $padname->LEN)
-           {
-               $targarg  = $padname->PVX;
-               if ($padname->FLAGS & SVf_FAKE) {
-                   # These changes relate to the jumbo closure fix.
-                   # See changes 19939 and 20005
-                   my $fake = '';
-                   $fake .= 'a'
-                       if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_ANON;
-                   $fake .= 'm'
-                       if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_MULTI;
-                   $fake .= ':' . $padname->PARENT_PAD_INDEX
-                       if $curcv->CvFLAGS & CVf_ANON;
-                   $targarglife = "$targarg:FAKE:$fake";
-               }
-               else {
-                   my $intro = $padname->COP_SEQ_RANGE_LOW - $cop_seq_base;
-                   my $finish = int($padname->COP_SEQ_RANGE_HIGH) - $cop_seq_base;
-                   $finish = "end" if $finish == 999999999 - $cop_seq_base;
-                   $targarglife = "$targarg:$intro,$finish";
-               }
-           } else {
-               $targarglife = $targarg = "t" . ($h{targ}+$i);
-           }
+           my ($targarg, $targarglife) = padname($h{targ} + $i);
            push @targarg,     $targarg;
            push @targarglife, $targarglife;
        }
@@ -859,7 +877,8 @@ sub concise_op {
 
                 if ($op->private & $B::Op_private::defines{'OPpSPLIT_LEX'}) {
                     my $off = $op->pmreplroot; # union with op_pmtargetoff
-                    $extra = " => t$off";
+                    my ($name, $full) = padname($off);
+                    $extra = " => $full";
                 }
                 else {
                     # union with op_pmtargetoff, op_pmtargetgv