From: Father Chrysostomos Date: Sat, 24 Dec 2011 02:44:43 +0000 (-0800) Subject: [perl #81424] Make Deparse handle /aelemfast_lex/ X-Git-Tag: v5.15.7~518 X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/4b58603b60aa116b5fc03c6b7fb5bb3303aab4f9?ds=sidebyside;hp=d4963d040dfafb02552348395220af7f6f232dca [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 --- 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 $';