[perl #81424] Make Deparse handle /aelemfast_lex/

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).

diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index 9456ecf..3a46ad4 100644 (file)
--- 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 (file)
--- 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 $';