[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 (file)
--- 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 (file)
--- 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();