summaryrefslogtreecommitdiff
path: root/ext/B
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2016-09-19 16:42:45 +0100
committerDavid Mitchell <davem@iabyn.com>2016-10-04 11:18:40 +0100
commit4ad59fdb481181ca4ec84ec004a9b4a58ab357f6 (patch)
tree61f44d95731456aa27f852bc5f818b089f956ba8 /ext/B
parent47a8f19b6f8f837245506422e5a4d36804e7b56a (diff)
downloadperl-4ad59fdb481181ca4ec84ec004a9b4a58ab357f6.tar.gz
Concise.pm: extract padname code and fixup split
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
Diffstat (limited to 'ext/B')
-rw-r--r--ext/B/B/Concise.pm75
1 files changed, 47 insertions, 28 deletions
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index d525b5f897..315e00a4b6 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -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