From 4b58603b60aa116b5fc03c6b7fb5bb3303aab4f9 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Fri, 23 Dec 2011 18:44:43 -0800
Subject: [PATCH] [perl #81424] Make Deparse handle /aelemfast_lex/
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

B::Deparse’s pure_string subroutine, that checks whether an op tree
can fit in double-quotish syntax, didn’t know about aelemfast_lex, or,
formerly, aelemfast on lexical variables.  (It did know how to han-
dle aelemfast for package variables.)  Consequently it was deparsing
/$a[0]/ as $a[0] for a lexical @a.

/$a[0]/ with a package variable looks like this:

9        </> match() lK/RTIME ->a
8           <|> regcomp(other->9) sK/1 ->9
6              <1> regcreset sK/1 ->7
-                 <1> ex-aelem sK/2 ->8
-                    <1> ex-rv2av sKR/1 ->-
7                       <#> aelemfast[*s] s/1 ->8
-                    <0> ex-const s ->-

There are two null ops (ex-*) before the aelemfast.

/$a[0]/ with a lexical variable looks like this:

9        </> match() lK/RTIME ->a
8           <|> regcomp(other->9) sK/1 ->9
6              <1> regcreset sK/1 ->7
-                 <1> ex-aelem sK/2 ->8
7                    <0> aelemfast_lex[@s:1,2] sR/1 ->8
-                    <0> ex-const s ->-

There is only one null op (ex-aelem).
---
 dist/B-Deparse/Deparse.pm  | 7 +++++--
 dist/B-Deparse/t/deparse.t | 4 ++++
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index 9456ecf..3a46ad4 100644
--- a/dist/B-Deparse/Deparse.pm
+++ b/dist/B-Deparse/Deparse.pm
@@ -4367,9 +4367,12 @@ sub pure_string {
 	return 1;
     }
     elsif ($type eq "null" and $op->can('first') and not null $op->first and
-	   $op->first->name eq "null" and $op->first->can('first')
+	  ($op->first->name eq "null" and $op->first->can('first')
 	   and not null $op->first->first and
-	   $op->first->first->name eq "aelemfast") {
+	   $op->first->first->name eq "aelemfast"
+          or
+	   $op->first->name =~ /^aelemfast(?:_lex)?\z/
+	  )) {
 	return 1;
     }
     else {
diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t
index 3bb6c8a..3ddb539 100644
--- a/dist/B-Deparse/t/deparse.t
+++ b/dist/B-Deparse/t/deparse.t
@@ -749,6 +749,10 @@ pop @_;
 # The fix for [perl #20444] broke this.
 'foo' =~ do { () };
 ####
+# [perl #81424] match against aelemfast_lex
+my @s;
+print /$s[1]/;
+####
 # Test @threadsv_names under 5005threads
 foreach $' (1, 2) {
     sleep $';
-- 
1.8.3.1