In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/0e34d7d0a57487ce82a7d53150db6725b7e00068?hp=2018906832b2c4787a4decced6a41a76c670d14c>
- Log ----------------------------------------------------------------- commit 0e34d7d0a57487ce82a7d53150db6725b7e00068 Author: Father Chrysostomos <[email protected]> Date: Fri Sep 12 13:38:42 2014 -0700 Increase $B::Deparse::VERSION to 1.28 M lib/B/Deparse.pm commit 3b4e80b8318c782345224a5fba021cdf0725abf8 Author: Father Chrysostomos <[email protected]> Date: Fri Sep 12 23:37:28 2014 -0700 Deparse.pm:pp_list: Donât call $lop->name repeatedly because itâs inefficient. M lib/B/Deparse.pm commit 56cd2ef8a1ac2bb07d373c618daba2bd813409f6 Author: Father Chrysostomos <[email protected]> Date: Fri Sep 12 23:35:35 2014 -0700 Deparse typed vars M lib/B/Deparse.pm M lib/B/Deparse.t commit 66786896871dad5f544c0dd64c351a09ca3e612e Author: Father Chrysostomos <[email protected]> Date: Fri Sep 12 23:33:57 2014 -0700 Deparse our(LIST) correctly It was coming out like this: our($main::foo, $main::bar, $main::baz); M lib/B/Deparse.pm M lib/B/Deparse.t ----------------------------------------------------------------------- Summary of changes: lib/B/Deparse.pm | 72 ++++++++++++++++++++++++++++++++++++++++++++------------ lib/B/Deparse.t | 18 ++++++++++++++ 2 files changed, 75 insertions(+), 15 deletions(-) diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm index 470c829..c15b333 100644 --- a/lib/B/Deparse.pm +++ b/lib/B/Deparse.pm @@ -17,10 +17,11 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring OPpEXISTS_SUB OPpSORT_NUMERIC OPpSORT_INTEGER OPpSORT_REVERSE SVf_IOK SVf_NOK SVf_ROK SVf_POK SVpad_OUR SVf_FAKE SVs_RMG SVs_SMG + SVpad_TYPED CVf_METHOD CVf_LVALUE PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED); -$VERSION = '1.27'; +$VERSION = '1.28'; use strict; use vars qw/$AUTOLOAD/; use warnings (); @@ -221,8 +222,9 @@ BEGIN { # curcvlex: # Cached hash of lexical variables for curcv: keys are # names prefixed with "m" or "o" (representing my/our), and -# each value is an array of pairs, indicating the cop_seq of scopes -# in which a var of that name is valid. +# each value is an array with two elements indicating the cop_seq +# of scopes in which a var of that name is valid and a third ele- +# ment referencing the pad name. # # curcop: # COP for statement being deparsed @@ -1191,12 +1193,24 @@ sub maybe_parens_func { } } +sub find_our_type { + my ($self, $name) = @_; + $self->populate_curcvlex() if !defined $self->{'curcvlex'}; + my $seq = $self->{'curcop'}->cop_seq; + for my $a (@{$self->{'curcvlex'}{"o$name"}}) { + my ($st, undef, $padname) = @$a; + if ($st == $seq && $padname->FLAGS & SVpad_TYPED) { + return $padname->SvSTASH->NAME; + } + } + return ''; +} + sub maybe_local { my $self = shift; my($op, $cx, $text) = @_; my $our_intro = ($op->name =~ /^(gv|rv2)[ash]v$/) ? OPpOUR_INTRO : 0; - if ($op->private & (OPpLVAL_INTRO|$our_intro) - and not $self->{'avoid_local'}{$$op}) { + if ($op->private & (OPpLVAL_INTRO|$our_intro)) { my $our_local = ($op->private & OPpLVAL_INTRO) ? "local" : "our"; if( $our_local eq 'our' ) { if ( $text !~ /^\W(\w+::)*\w+\z/ @@ -1205,7 +1219,12 @@ sub maybe_local { die "Unexpected our($text)\n"; } $text =~ s/(\w+::)+//; + + if (my $type = $self->find_our_type($text)) { + $our_local .= ' ' . $type; + } } + return $text if $self->{'avoid_local'}{$$op}; if (want_scalar($op)) { return "$our_local $text"; } else { @@ -1236,11 +1255,15 @@ sub padname_sv { sub maybe_my { my $self = shift; - my($op, $cx, $text, $forbid_parens) = @_; + my($op, $cx, $padname, $forbid_parens) = @_; + my $text = $padname->PVX; if ($op->private & OPpLVAL_INTRO and not $self->{'avoid_local'}{$$op}) { my $my = $op->private & OPpPAD_STATE ? $self->keyword("state") : "my"; + if ($padname->FLAGS & SVpad_TYPED) { + $my .= ' ' . $padname->SvSTASH->NAME; + } if ($forbid_parens || want_scalar($op)) { return "$my $text"; } else { @@ -1517,7 +1540,7 @@ sub populate_curcvlex { push @{$self->{'curcvlex'}{ ($ns[$i]->FLAGS & SVpad_OUR ? 'o' : 'm') . $name - }}, [$seq_st, $seq_en]; + }}, [$seq_st, $seq_en, $ns[$i]]; } } } @@ -2963,6 +2986,7 @@ sub pp_list { return '' if class($kid) eq 'NULL'; my $lop; my $local = "either"; # could be local(...), my(...), state(...) or our(...) + my $type; for ($lop = $kid; !null($lop); $lop = $lop->sibling) { # This assumes that no other private flags equal 128, and that # OPs that store things other than flags in their op_private, @@ -2973,14 +2997,16 @@ sub pp_list { # XXX This really needs to be rewritten to accept only those ops # known to take the OPpLVAL_INTRO flag. + my $lopname = $lop->name; if (!($lop->private & (OPpLVAL_INTRO|OPpOUR_INTRO) - or $lop->name eq "undef") - or $lop->name =~ /^(?:entersub|exit|open|split)\z/) + or $lopname eq "undef") + or $lopname =~ /^(?:entersub|exit|open|split)\z/) { $local = ""; # or not last; } - if ($lop->name =~ /^pad[ash]v$/) { + my $newtype; + if ($lopname =~ /^pad[ash]v$/) { if ($lop->private & OPpPAD_STATE) { # state() ($local = "", last) if $local =~ /^(?:local|our|my)$/; $local = "state"; @@ -2988,23 +3014,39 @@ sub pp_list { ($local = "", last) if $local =~ /^(?:local|our|state)$/; $local = "my"; } - } elsif ($lop->name =~ /^(gv|rv2)[ash]v$/ + my $padname = $self->padname_sv($lop->targ); + if ($padname->FLAGS & SVpad_TYPED) { + $newtype = $padname->SvSTASH->NAME; + } + } elsif ($lopname =~ /^(?:gv|rv2)([ash])v$/ && $lop->private & OPpOUR_INTRO - or $lop->name eq "null" && $lop->first->name eq "gvsv" + or $lopname eq "null" && $lop->first->name eq "gvsv" && $lop->first->private & OPpOUR_INTRO) { # our() ($local = "", last) if $local =~ /^(?:my|local|state)$/; $local = "our"; - } elsif ($lop->name ne "undef" + my $funny = !$1 || $1 eq 's' ? '$' : $1 eq 'a' ? '@' : '%'; + if (my $t = $self->find_our_type( + $funny . $self->gv_or_padgv($lop->first)->NAME + )) { + $newtype = $t; + } + } elsif ($lopname ne "undef" # specifically avoid the "reverse sort" optimisation, # where "reverse" is nullified - && !($lop->name eq 'sort' && ($lop->flags & OPpSORT_REVERSE))) + && !($lopname eq 'sort' && ($lop->flags & OPpSORT_REVERSE))) { # local() ($local = "", last) if $local =~ /^(?:my|our|state)$/; $local = "local"; } + if (defined $type && defined $newtype && $newtype ne $type) { + $local = ''; + last; + } + $type = $newtype; } $local = "" if $local eq "either"; # no point if it's all undefs + $local .= " $type " if $local && length $type; return $self->deparse($kid, $cx) if null $kid->sibling and not $local; for (; !null($kid); $kid = $kid->sibling) { if ($local) { @@ -3288,7 +3330,7 @@ sub padany { sub pp_padsv { my $self = shift; my($op, $cx, $forbid_parens) = @_; - return $self->maybe_my($op, $cx, $self->padname($op->targ), + return $self->maybe_my($op, $cx, $self->padname_sv($op->targ), $forbid_parens); } diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t index c804b70..81f0f37 100644 --- a/lib/B/Deparse.t +++ b/lib/B/Deparse.t @@ -344,6 +344,24 @@ print $main::x[1]; my %x; $x{warn()}; #### +# our (LIST) +our($foo, $bar, $baz); +#### +# CONTEXT { package Dog } use feature "state"; +# variables with declared classes +my Dog $spot; +our Dog $spotty; +state Dog $spotted; +my Dog @spot; +our Dog @spotty; +state Dog @spotted; +my Dog %spot; +our Dog %spotty; +state Dog %spotted; +my Dog ($foo, @bar, %baz); +our Dog ($phoo, @barr, %bazz); +state Dog ($fough, @barre, %bazze); +#### # <> my $foo; $_ .= <ARGV> . <$foo>; -- Perl5 Master Repository
