propagate lexical warnings from surrounding scope correctly

within string eval()

p4raw-id: //depot/perl@5934

diff --git a/pp_ctl.c b/pp_ctl.c
index d2e795f..4fcfb57 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3261,9 +3261,11 @@ PP(pp_entereval)
     SAVEHINTS();
     PL_hints = PL_op->op_targ;
     SAVESPTR(PL_compiling.cop_warnings);
-    if (!specialWARN(PL_compiling.cop_warnings)) {
-        PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
-        SAVEFREESV(PL_compiling.cop_warnings) ;
+    if (specialWARN(PL_curcop->cop_warnings))
+        PL_compiling.cop_warnings = PL_curcop->cop_warnings;
+    else {
+        PL_compiling.cop_warnings = newSVsv(PL_curcop->cop_warnings);
+        SAVEFREESV(PL_compiling.cop_warnings);
     }
 
     push_return(PL_op->op_next);

diff --git a/t/pragma/warn/pp_ctl b/t/pragma/warn/pp_ctl
index 0deccd3..ac01f27 100644 (file)
--- a/t/pragma/warn/pp_ctl
+++ b/t/pragma/warn/pp_ctl
@@ -214,4 +214,17 @@ DESTROY { die "@{$_[0]} foo bar" }
 { bless ['A'], 'Foo' for 1..10 }
 { bless ['B'], 'Foo' for 1..10 }
 EXPECT
-
+########
+# pp_ctl.c
+use warnings;
+eval 'print $foo';
+EXPECT
+Use of uninitialized value in print at (eval 1) line 1.
+########
+# pp_ctl.c
+use warnings;
+{
+    no warnings;
+    eval 'print $foo';
+}
+EXPECT