diff options
author | David Mitchell <davem@iabyn.com> | 2016-09-19 16:42:45 +0100 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2016-10-04 11:18:40 +0100 |
commit | 4ad59fdb481181ca4ec84ec004a9b4a58ab357f6 (patch) | |
tree | 61f44d95731456aa27f852bc5f818b089f956ba8 /ext/B | |
parent | 47a8f19b6f8f837245506422e5a4d36804e7b56a (diff) | |
download | perl-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.pm | 75 |
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 |