diff options
author | Lukas Mai <l.mai@web.de> | 2015-11-21 01:15:24 +0100 |
---|---|---|
committer | Lukas Mai <l.mai@web.de> | 2015-11-21 01:28:15 +0100 |
commit | 18371617dfbc5af3f05e76e5c3e48b1a1d972b9d (patch) | |
tree | 830ee455b1d5d74706be6199616cb4a0555eb65c /lib | |
parent | 4639a3a7d1d9f85f2e8510b689a8e047b15ed452 (diff) | |
download | perl-18371617dfbc5af3f05e76e5c3e48b1a1d972b9d.tar.gz |
[perl #116677] always deparse <> as either glob or readline
Diffstat (limited to 'lib')
-rw-r--r-- | lib/B/Deparse.pm | 28 | ||||
-rw-r--r-- | lib/B/Deparse.t | 23 |
2 files changed, 31 insertions, 20 deletions
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm index d4c6f6061a..7d9ad2bc4d 100644 --- a/lib/B/Deparse.pm +++ b/lib/B/Deparse.pm @@ -46,7 +46,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring MDEREF_SHIFT ); -$VERSION = '1.35'; +$VERSION = '1.36'; use strict; use vars qw/$AUTOLOAD/; use warnings (); @@ -2642,10 +2642,11 @@ sub pp_readline { my $self = shift; my($op, $cx) = @_; my $kid = $op->first; - if (is_scalar($kid)) { - my $kid_deparsed = $self->deparse($kid, 1); - return '<<>>' if $op->flags & OPf_SPECIAL and $kid_deparsed eq 'ARGV'; - return "<$kid_deparsed>"; + if (is_scalar($kid) + and $op->flags & OPf_SPECIAL + and $self->deparse($kid, 1) eq 'ARGV') + { + return '<<>>'; } return $self->unop($op, $cx, "readline"); } @@ -3221,19 +3222,10 @@ sub pp_glob { my $kid = $op->first->sibling; # skip pushmark my $keyword = $op->flags & OPf_SPECIAL ? 'glob' : $self->keyword('glob'); - my $text; - if ($keyword =~ /^CORE::/ - or $kid->name ne 'const' - or ($text = $self->dq($kid)) - =~ /^\$?(\w|::|\`)+$/ # could look like a readline - or $text =~ /[<>]/) { - $text = $self->deparse($kid); - return $cx >= 5 || $self->{'parens'} - ? "$keyword($text)" - : "$keyword $text"; - } else { - return '<' . $text . '>'; - } + my $text = $self->deparse($kid); + return $cx >= 5 || $self->{'parens'} + ? "$keyword($text)" + : "$keyword $text"; } # Truncate is special because OPf_SPECIAL makes a bareword first arg diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t index 62c0a4b84f..704b31e67e 100644 --- a/lib/B/Deparse.t +++ b/lib/B/Deparse.t @@ -128,7 +128,7 @@ $b = quotemeta <<'EOF'; BEGIN { $^I = ".bak"; } BEGIN { $^W = 1; } BEGIN { $/ = "\n"; $\ = "\n"; } -LINE: while (defined($_ = <ARGV>)) { +LINE: while (defined($_ = readline ARGV)) { chomp $_; our(@F) = split(' ', $_, 0); '???'; @@ -628,12 +628,27 @@ local our($rhu, $barb); #### # <> my $foo; -$_ .= <ARGV> . <$foo>; +$_ .= <> . <ARGV> . <$foo>; +<$foo>; +<${foo}>; +<$ foo>; +>>>> +my $foo; +$_ .= readline(ARGV) . readline(ARGV) . readline($foo); +readline $foo; +glob $foo; +glob $foo; #### # readline readline 'FH'; readline *$_; +readline *{$_}; +readline ${"a"}; +>>>> +readline 'FH'; +readline *$_; readline *{$_;}; +readline ${'a';}; #### # <<>> $_ = <<>>; @@ -1363,6 +1378,10 @@ tr/a/b/r + $a =~ tr/p/q/r; #### # [perl #90898] <a,>; +glob 'a,'; +>>>> +glob 'a,'; +glob 'a,'; #### # [perl #91008] # SKIP ?$] >= 5.023 && "autoderef deleted in this Perl version" |