From 36727b534b2c3bc6309920028fdbb8df5f8f8578 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sat, 24 Dec 2011 17:54:16 -0800
Subject: Deparse /$#a/ correctly
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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.
---
 dist/B-Deparse/Deparse.pm  | 5 +++--
 dist/B-Deparse/t/deparse.t | 5 ++++-
 2 files changed, 7 insertions(+), 3 deletions(-)

(limited to 'dist')

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;
-- 
cgit v1.2.1