From: Father Chrysostomos <sprout@cpan.org>
Date: Sun, 22 Jan 2012 22:07:04 +0000 (-0800)
Subject: [rt.cpan.org #72767] Don’t propagate warnings into do-file
X-Git-Tag: accepted/trunk/20130322.191538~1005
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=3840c57b8cefe640d72c4ad40d0b13c41cf80f6d;p=platform%2Fupstream%2Fperl.git

[rt.cpan.org #72767] Don’t propagate warnings into do-file

I completely forgot about do-file when, in commit f45b078d2, I stopped
eval from localising hints at run time.  The result was that warning
hints were propagating into do-file.
---

diff --git a/pp_ctl.c b/pp_ctl.c
index 038eae0..96c3972 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3478,8 +3478,8 @@ S_try_yyparse(pTHX_ int gramtype)
 /* This function is called from three places, sv_compile_2op, pp_return
  * and pp_entereval.  These can be distinguished as follows:
  *    sv_compile_2op - startop is non-null
- *    pp_require     - startop is null; in_require is true
- *    pp_entereval   - stortop is null; in_require is false
+ *    pp_require     - startop is null; saveop is not entereval
+ *    pp_entereval   - startop is null; saveop is entereval
  */
 
 STATIC bool
@@ -3549,8 +3549,9 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq, HV *hh)
 	CLEAR_ERRSV();
 
     if (!startop) {
+	bool clear_hints = saveop->op_type != OP_ENTEREVAL;
 	SAVEHINTS();
-	if (in_require) {
+	if (clear_hints) {
 	    PL_hints = 0;
 	    hv_clear(GvHV(PL_hintgv));
 	}
@@ -3564,7 +3565,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq, HV *hh)
 	    }
 	}
 	SAVECOMPILEWARNINGS();
-	if (in_require) {
+	if (clear_hints) {
 	    if (PL_dowarn & G_WARN_ALL_ON)
 	        PL_compiling.cop_warnings = pWARN_ALL ;
 	    else if (PL_dowarn & G_WARN_ALL_OFF)
diff --git a/t/op/do.t b/t/op/do.t
index aae6aac..93d3f73 100644
--- a/t/op/do.t
+++ b/t/op/do.t
@@ -264,4 +264,26 @@ is($x, 4, 'if (0){} else { ...; @a } receives caller scalar context');
 @x = sub { if (0){} else { 0; @a } }->();
 is("@x", "24 25 26 27", 'if (0){} else { ...; @a } receives caller list context');
 
+# [rt.cpan.org #72767] do "string" should not propagate warning hints
+SKIP: {
+  skip_if_miniperl("no in-memory files under miniperl", 1);
+
+  my $code = '42; 1';
+  # Based on Eval::WithLexicals::_eval_do
+  local @INC = (sub {
+    if ($_[1] eq '/eval_do') {
+      open my $fh, '<', \$code;
+      $fh;
+    } else {
+      ();
+    }
+  }, @INC);
+  local $^W;
+  use warnings;
+  my $w;
+  local $SIG{__WARN__} = sub { warn shift; ++$w };
+  do '/eval_do' or die $@;
+  is($w, undef, 'do STRING does not propagate warning hints');
+}
+
 done_testing();