In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/3840c57b8cefe640d72c4ad40d0b13c41cf80f6d?hp=5fa409a90f64110c5708f7141b376e9bdc54fbe2>
- Log ----------------------------------------------------------------- commit 3840c57b8cefe640d72c4ad40d0b13c41cf80f6d Author: Father Chrysostomos <[email protected]> Date: Sun Jan 22 14:07:04 2012 -0800 [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. ----------------------------------------------------------------------- Summary of changes: pp_ctl.c | 9 +++++---- t/op/do.t | 22 ++++++++++++++++++++++ 2 files changed, 27 insertions(+), 4 deletions(-) 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(); -- Perl5 Master Repository
