From 2e2e3f36ef0a7bee034eac9575fdb70698beec72 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Fri, 30 Mar 2012 16:30:26 +0100
Subject: [PATCH 1/1] ensure regex evals report the right location

make sure that PL_curcop is set correctly on entry to a regex code block,
since (unlike a normal eval) there isn't always an initial OP_NEXTSTATE to
cause it to get set.  Otherwise, warning messages etc in the first
statement of the code block will appear to come from the wrong place.
---
 regcomp.c          |  4 ++--
 regexec.c          | 32 ++++++++++++++++++++++++++++++++
 t/re/pat_re_eval.t | 33 ++++++++++++++++++++++++++++++++-
 3 files changed, 66 insertions(+), 3 deletions(-)

diff --git a/regcomp.c b/regcomp.c
index f3052de..b9f9e41 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -8604,12 +8604,12 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
 			n = add_data(pRExC_state, 2, "rl");
 			RExC_rxi->data->data[n] =
 			    (void*)SvREFCNT_inc((SV*)cb->src_regex);
-			RExC_rxi->data->data[n+1] = (void*)o->op_next;
+			RExC_rxi->data->data[n+1] = (void*)o;
 		    }
 		    else {
 			n = add_data(pRExC_state, 1,
 			       (RExC_pm_flags & PMf_HAS_CV) ? "L" : "l");
-			RExC_rxi->data->data[n] = (void*)o->op_next;
+			RExC_rxi->data->data[n] = (void*)o;
 		    }
 		}
 		pRExC_state->code_index++;
diff --git a/regexec.c b/regexec.c
index f94d15a..21bbf76 100644
--- a/regexec.c
+++ b/regexec.c
@@ -4290,6 +4290,38 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		    new_comppad =  (PAD*)AvARRAY(CvPADLIST(rex->qr_anoncv))[1];
 		    PL_op = (OP_4tree*)rexi->data->data[n];
 		}
+		/* the initial nextstate you would normally execute
+		 * at the start of an eval (which would cause error
+		 * messages to come from the eval), may be optimised
+		 * away from the execution path in the regex code blocks;
+		 * so manually set PL_curcop to it initially */
+		{
+		    OP *o = cUNOPx(PL_op)->op_first;
+		    assert(o->op_type == OP_NULL);
+		    if (o->op_targ == OP_SCOPE) {
+			o = cUNOPo->op_first;
+		    }
+		    else {
+			assert(o->op_targ == OP_LEAVE);
+			o = cUNOPo->op_first;
+			assert(o->op_type == OP_ENTER);
+			o = o->op_sibling;
+		    }
+
+		    if (o->op_type != OP_STUB) {
+			assert(    o->op_type == OP_NEXTSTATE
+				|| o->op_type == OP_DBSTATE
+				|| (o->op_type == OP_NULL
+				    &&  (  o->op_targ == OP_NEXTSTATE
+					|| o->op_targ == OP_DBSTATE
+					)
+				    )
+			);
+			PL_curcop = (COP*)o;
+		    }
+		}
+		PL_op = PL_op->op_next;
+
 		DEBUG_STATE_r( PerlIO_printf(Perl_debug_log, 
 		    "  re EVAL PL_op=0x%"UVxf"\n", PTR2UV(PL_op)) );
 		/* wrap the call in two SAVECOMPPADs. This ensures that
diff --git a/t/re/pat_re_eval.t b/t/re/pat_re_eval.t
index 0e116b1..ecde318 100644
--- a/t/re/pat_re_eval.t
+++ b/t/re/pat_re_eval.t
@@ -23,7 +23,7 @@ BEGIN {
 }
 
 
-plan tests => 352;  # Update this when adding/deleting tests.
+plan tests => 355;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -732,6 +732,37 @@ sub run_tests {
 	ok("a{" =~ /^${\'(??{"a{"})'}$/, "runtime code with unbalanced {}");
     }
 
+    # make sure warnings come from the right place
+
+    {
+	use warnings;
+	my ($s, $t, $w);
+	local $SIG{__WARN__} = sub { $w .= "@_" };
+
+	$w = ''; $s = 's';
+	my $r = qr/(?{$t=$s+1})/;
+	"a" =~ /a$r/;
+	like($w, qr/pat_re_eval/, "warning main file");
+
+	# do it in an eval to get predictable line numbers
+	eval q[
+
+	    $r = qr/(?{$t=$s+1})/;
+	];
+	$w = ''; $s = 's';
+	"a" =~ /a$r/;
+	like($w, qr/ at \(eval \d+\) line 3/, "warning eval A");
+
+	$w = ''; $s = 's';
+	eval q[
+	    use re 'eval';
+	    my $c = '(?{$t=$s+1})';
+	    "a" =~ /a$c/;
+	    1;
+	];
+	like($w, qr/ at \(eval \d+\) line 1/, "warning eval B");
+    }
+
 } # End of sub run_tests
 
 1;
-- 
1.8.3.1