(perl #130705) don't convert match with argument to qr
authorTony Cook <tony@develop-help.com>
Wed, 8 Feb 2017 03:38:45 +0000 (14:38 +1100)
committerTony Cook <tony@develop-help.com>
Wed, 8 Feb 2017 03:38:59 +0000 (14:38 +1100)
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

op.c
t/op/smartmatch.t

diff --git a/op.c b/op.c
index def6aca..54993b5 100644 (file)
--- 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);
         }
     }
index ca019fd..10d3539 100644 (file)
@@ -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