[perl #20444] regex not evaluated in constant ?:

  $text =~ ( 1 ? /phoo/ : /bear/)

used to be constant-folded to

  $text =~ /phoo/

This patch solves the problem by marking match and subst ops as
OPf_SPECIAL during constant folding, so the =~ operator can tell not
to take possession of it.

diff --git a/op.c b/op.c
index 75a52c3..db91cdb 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2236,9 +2236,10 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
        type == OP_NOT)
        yyerror("Using !~ with s///r doesn't make sense");
 
-    ismatchop = rtype == OP_MATCH ||
-               rtype == OP_SUBST ||
-               rtype == OP_TRANS;
+    ismatchop = (rtype == OP_MATCH ||
+                rtype == OP_SUBST ||
+                rtype == OP_TRANS)
+            && !(right->op_flags & OPf_SPECIAL);
     if (ismatchop && right->op_private & OPpTARGET_MY) {
        right->op_targ = 0;
        right->op_private &= ~OPpTARGET_MY;
@@ -4876,6 +4877,11 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
            op_free(first);
            if (other->op_type == OP_LEAVE)
                other = newUNOP(OP_NULL, OPf_SPECIAL, other);
+           else if (other->op_type == OP_MATCH
+                 || other->op_type == OP_SUBST
+                 || other->op_type == OP_TRANS)
+               /* Mark the op as being unbindable with =~ */
+               other->op_flags |= OPf_SPECIAL;
            return other;
        }
        else {
@@ -5028,6 +5034,10 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
        }
        if (live->op_type == OP_LEAVE)
            live = newUNOP(OP_NULL, OPf_SPECIAL, live);
+       else if (live->op_type == OP_MATCH || live->op_type == OP_SUBST
+             || live->op_type == OP_TRANS)
+           /* Mark the op as being unbindable with =~ */
+           live->op_flags |= OPf_SPECIAL;
        return live;
     }
     NewOp(1101, logop, 1, LOGOP);

diff --git a/op.h b/op.h
index 2ffd3e6..da280b8 100644 (file)
--- a/op.h
+++ b/op.h
@@ -142,6 +142,10 @@ Deprecated.  Use C<GIMME_V> instead.
                                /*  On OP_HELEM and OP_HSLICE, localization will be followed
                                    by assignment, so do not wipe the target if it is special
                                    (e.g. a glob or a magic SV) */
+                               /*  On OP_MATCH, OP_SUBST & OP_TRANS, the
+                                   operand of a logical or conditional
+                                   that was optimised away, so it should
+                                   not be bound via =~ */
 
 /* old names; don't use in new code, but don't break them, either */
 #define OPf_LIST       OPf_WANT_LIST

diff --git a/t/comp/fold.t b/t/comp/fold.t
index 23e8e89..ec95f1a 100644 (file)
--- a/t/comp/fold.t
+++ b/t/comp/fold.t
@@ -4,7 +4,7 @@
 # we've not yet verified that use works.
 # use strict;
 
-print "1..13\n";
+print "1..19\n";
 my $test = 0;
 
 # Historically constant folding was performed by evaluating the ops, and if
@@ -52,6 +52,16 @@ sub is {
     failed($got, "'$expect'", $name);
 }
 
+sub ok {
+    my ($got, $name) = @_;
+    $test = $test + 1;
+    if ($got) {
+       print "ok $test - $name\n";
+       return 1;
+    }
+    failed($got, "a true value", $name);
+}
+
 my $a;
 $a = eval '$b = 0/0 if 0; 3';
 is ($a, 3, 'constants in conditionals don\'t affect constant folding');
@@ -88,3 +98,23 @@ is ($@, '', 'no error');
     like ($@, qr/division/, "eval caught division");
     is($c, 2, "missing die hook");
 }
+
+# [perl #20444] Constant folding should not change the meaning of match
+# operators.
+{
+ local *_;
+ $_="foo"; my $jing = 1;
+ ok scalar $jing =~ (1 ? /foo/ : /bar/),
+   'lone m// is not bound via =~ after ? : folding';
+ ok scalar $jing =~ (0 || /foo/),
+   'lone m// is not bound via =~ after || folding';
+ ok scalar $jing =~ (1 ? s/foo/foo/ : /bar/),
+   'lone s/// is not bound via =~ after ? : folding';
+ ok scalar $jing =~ (0 || s/foo/foo/),
+   'lone s/// is not bound via =~ after || folding';
+ $jing = 3;
+ ok scalar $jing =~ (1 ? y/fo// : /bar/),
+   'lone y/// is not bound via =~ after ? : folding';
+ ok scalar $jing =~ (0 || y/fo//),
+   'lone y/// is not bound via =~ after || folding';
+}