summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2011-12-24 17:54:16 -0800
committerFather Chrysostomos <sprout@cpan.org>2011-12-24 19:14:24 -0800
commit36727b534b2c3bc6309920028fdbb8df5f8f8578 (patch)
treee87bff3b62094c6a65fd68389b9c835badba8bd6
parentdb3abe521abb44011448508a58c8da53c407fb44 (diff)
downloadperl-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.pm5
-rw-r--r--dist/B-Deparse/t/deparse.t5
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;