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.

1 files changed, 32 insertions, 1 deletions

diff --git a/t/re/pat_re_eval.t b/t/re/pat_re_eval.t
index 0e116b13c0..ecde318233 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;