From 2474a784a94d8c70aea9c330d9f2a902b8a68b85 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Mon, 20 Sep 2010 22:05:34 -0700
Subject: [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.
---
 op.c          | 16 +++++++++++++---
 op.h          |  4 ++++
 t/comp/fold.t | 32 +++++++++++++++++++++++++++++++-
 3 files changed, 48 insertions(+), 4 deletions(-)

diff --git a/op.c b/op.c
index 75a52c31ed..db91cdb913 100644
--- 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 2ffd3e6f16..da280b8b8d 100644
--- 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 23e8e89b62..ec95f1aed8 100644
--- 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';
+}
-- 
cgit v1.2.1