diff options
author | Father Chrysostomos <sprout@cpan.org> | 2011-12-24 17:54:16 -0800 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2011-12-24 19:14:24 -0800 |
commit | 36727b534b2c3bc6309920028fdbb8df5f8f8578 (patch) | |
tree | e87bff3b62094c6a65fd68389b9c835badba8bd6 | |
parent | db3abe521abb44011448508a58c8da53c407fb44 (diff) | |
download | perl-36727b534b2c3bc6309920028fdbb8df5f8f8578.tar.gz |
Deparse /$#a/ correctly
This is related to 4b58603b60.
This time it’s this op tree that pure_string can’t handle:
8 </> match() vK/RTIME ->9
7 <|> regcomp(other->8) sK/1 ->8
3 <1> regcreset sK/1 ->4
6 <1> av2arylen sK/1 ->7
5 <1> rv2av[t2] sKR/1 ->6
4 <#> gv[*a] s ->5
In writing a test for this, I triggered a case that 415d4c68d missed
(only $a and $b are exempt from strict vars, not @a and @b), so that
is fixed in the same commit.
-rw-r--r-- | dist/B-Deparse/Deparse.pm | 5 | ||||
-rw-r--r-- | dist/B-Deparse/t/deparse.t | 5 |
2 files changed, 7 insertions, 3 deletions
diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm index ccc8bc084c..648a17c14a 100644 --- a/dist/B-Deparse/Deparse.pm +++ b/dist/B-Deparse/Deparse.pm @@ -1335,7 +1335,8 @@ sub maybe_qualify { return $name if !$prefix || $name =~ /::/; return $self->{'curstash'}.'::'. $name if - $name =~ /^(?!\d|[ab]\z)\w/ # alphabetic (except $a and $b) + $name =~ /^(?!\d)\w/ # alphabetic + && $v !~ /^\$[ab]\z/ # not $a or $b && !$globalnames{$name} # not a global name && $self->{hints} & $strict_bits{vars} # strict vars && !$self->lex_in_scope($v,1) # no "our" @@ -4448,7 +4449,7 @@ sub pure_string { return 0 if null $op; my $type = $op->name; - if ($type eq 'const') { + if ($type eq 'const' || $type eq 'av2arylen') { return 1; } elsif ($type =~ /^[ul]c(first)?$/ || $type eq 'quotemeta') { diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t index 68d33463c1..a7aaa3181d 100644 --- a/dist/B-Deparse/t/deparse.t +++ b/dist/B-Deparse/t/deparse.t @@ -20,7 +20,7 @@ BEGIN { use Test::More; use Config (); -plan tests => 129; +plan tests => 130; use B::Deparse; my $deparse = B::Deparse->new(); @@ -784,6 +784,9 @@ pop @_; my @s; print /$s[1]/; #### +# /$#a/ +print /$#main::a/; +#### # [perl #91318] /regexp/applaud print /a/a, s/b/c/a; print /a/aa, s/b/c/aa; |