In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/d6851fe9ee8e6b96009415e29da3235452bd8045?hp=a89802816ca9b489a3239d20e67e3d724a0f78ca>
- Log ----------------------------------------------------------------- commit d6851fe9ee8e6b96009415e29da3235452bd8045 Author: Tony Cook <[email protected]> Date: Wed Feb 8 14:38:45 2017 +1100 (perl #130705) don't convert match with argument to qr Code like: 0 =~ qr/1/ ~~ 0 would have the match operator replaced with qr, leaving an op tree like: e <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 2 <;> nextstate(main 1 -e:1) v:{ ->3 d <@> print vK ->e 3 <0> pushmark s ->4 c <2> aelem sK/2 ->d 5 <1> rv2av[t1] sKR/1 ->6 4 <$> gv(*0) s ->5 b <2> smartmatch sK/2 ->c 9 </> qr() sKS ->a <=== umm 6 <$> const(IV 0) s ->7 8 <|> regcomp(other->9) sK ->9 7 </> qr(/"1"/) s ->8 a <$> const(IV 0) s ->b when executed, this would leave an extra value on the stack: $ ./perl -Dst -e 'print(0->[0 =~ qr/1/ ~~ 0])' Smartmatch is experimental at -e line 1. EXECUTING... => (-e:0) enter => (-e:0) nextstate => (-e:1) pushmark => * (-e:1) gv(main::0) => * GV() (-e:1) rv2av => * AV() (-e:1) const(IV(0)) => * AV() IV(0) (-e:1) qr => * AV() IV(0) \REGEXP() (-e:1) regcomp => * AV() IV(0) (-e:1) qr => * AV() IV(0) \REGEXP() (-e:1) const(IV(0)) => * AV() IV(0) \REGEXP() IV(0) (-e:1) smartmatch => * AV() IV(0) SV_NO (-e:1) aelem => * AV() SV_UNDEF <=== trying to print an AV (-e:1) print perl: sv.c:2941: Perl_sv_2pv_flags: Assertion `((svtype)((sv)->sv_flags & 0xff)) != SVt_PVAV && ((svtype)((sv)->sv_flags & 0xff)) != SVt_PVHV && ((svtype)((sv)->sv_flags & 0xff)) != SVt_PVFM' failed. Aborted ----------------------------------------------------------------------- Summary of changes: op.c | 4 ++-- t/op/smartmatch.t | 21 ++++++++++++++++++++- 2 files changed, 22 insertions(+), 3 deletions(-) diff --git a/op.c b/op.c index def6aca846..54993b57ce 100644 --- a/op.c +++ b/op.c @@ -10558,10 +10558,10 @@ Perl_ck_smartmatch(pTHX_ OP *o) op_sibling_splice(o, NULL, 0, first); /* Implicitly take a reference to a regular expression */ - if (first->op_type == OP_MATCH) { + if (first->op_type == OP_MATCH && !(first->op_flags & OPf_STACKED)) { OpTYPE_set(first, OP_QR); } - if (second->op_type == OP_MATCH) { + if (second->op_type == OP_MATCH && !(second->op_flags & OPf_STACKED)) { OpTYPE_set(second, OP_QR); } } diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t index ca019fdbbb..10d35390d7 100644 --- a/t/op/smartmatch.t +++ b/t/op/smartmatch.t @@ -76,7 +76,7 @@ my %keyandmore = map { $_ => 0 } @keyandmore; my %fooormore = map { $_ => 0 } @fooormore; # Load and run the tests -plan tests => 349+2; +plan tests => 349+4; while (<DATA>) { SKIP: { @@ -182,6 +182,25 @@ sub NOT_DEF() { undef } } +{ + # [perl #130705] + # Perl_ck_smartmatch would turn the match in: + # 0 =~ qr/1/ ~~ 0 # parsed as (0 =~ qr/1/) ~~ 0 + # into a qr, leaving the initial 0 on the stack after execution + # + # Similarly for: 0 ~~ (0 =~ qr/1/) + # + # Either caused an assertion failure in the context of warn (or print) + # if there was some other operator's arguments left on the stack, as with + # the test cases. + fresh_perl_is('print(0->[0 =~ qr/1/ ~~ 0])', '', + { switches => [ "-M-warnings=experimental::smartmatch" ] }, + "don't qr-ify left-side match against a stacked argument"); + fresh_perl_is('print(0->[0 ~~ (0 =~ qr/1/)])', '', + { switches => [ "-M-warnings=experimental::smartmatch" ] }, + "don't qr-ify right-side match against a stacked argument"); +} + # Prefix character : # - expected to match # ! - expected to not match -- Perl5 Master Repository
