Skip warnable const folding outside warnings scope

Constant folding is not supposed to warn.  If it would produce a warn-
ing, then it is skipped and the warning is deferred to run time.

This means the -w flag can affect constant folding:

$ ./perl -Ilib -MO=Concise -le 'use constant u=>undef; $a = u+1'
6  <@> leave[1 ref] vKP/REFC ->(end)
1     <0> enter ->2
2     <;> nextstate(main 132 -e:1) v:{ ->3
5     <2> sassign vKS/2 ->6
3        <$> const[NV 1] s/FOLD ->4
-        <1> ex-rv2sv sKRM*/1 ->5
4           <#> gvsv[*a] s ->5
-e syntax OK
$ ./perl -Ilib -MO=Concise -lwe 'use constant u=>undef; $a = u+1'
8  <@> leave[1 ref] vKP/REFC ->(end)
1     <0> enter ->2
2     <;> nextstate(main 132 -e:1) v:{ ->3
7     <2> sassign vKS/2 ->8
5        <2> add[t2] sK/2 ->6
3           <$> const[NULL ] s*/FOLD ->4
4           <$> const[PVNV 1] s ->5
-        <1> ex-rv2sv sKRM*/1 ->7
6           <#> gvsv[*a] s ->7
-e syntax OK

But the problem here is that the flag could be turned on at run time,
so if the folding happens because -w is off, then the behaviour
changes due to folding.  It’s fine to do the folding here only when
warnings are lexically disabled, as that overrides any setting of -w.

diff --git a/op.c b/op.c
index abe93a7..8add42d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3726,6 +3726,7 @@ S_fold_constants(pTHX_ OP *o)
     SV * const oldwarnhook = PL_warnhook;
     SV * const olddiehook  = PL_diehook;
     COP not_compiling;
+    U8 oldwarn = PL_dowarn;
     dJMPENV;
 
     PERL_ARGS_ASSERT_FOLD_CONSTANTS;
@@ -3820,6 +3821,10 @@ S_fold_constants(pTHX_ OP *o)
     PL_diehook  = NULL;
     JMPENV_PUSH(ret);
 
+    /* Effective $^W=1.  */
+    if ( ! (PL_dowarn & G_WARN_ALL_MASK))
+       PL_dowarn |= G_WARN_ON;
+
     switch (ret) {
     case 0:
        CALLRUNOPS(aTHX);
@@ -3849,6 +3854,7 @@ S_fold_constants(pTHX_ OP *o)
        Perl_croak(aTHX_ "panic: fold_constants JMPENV_PUSH returned %d", ret);
     }
     JMPENV_POP;
+    PL_dowarn   = oldwarn;
     PL_warnhook = oldwarnhook;
     PL_diehook  = olddiehook;
     PL_curcop = &PL_compiling;

diff --git a/t/comp/fold.t b/t/comp/fold.t
index 844ee41..4fa0734 100644 (file)
--- a/t/comp/fold.t
+++ b/t/comp/fold.t
@@ -4,7 +4,7 @@
 # we've not yet verified that use works.
 # use strict;
 
-print "1..29\n";
+print "1..30\n";
 my $test = 0;
 
 # Historically constant folding was performed by evaluating the ops, and if
@@ -171,3 +171,12 @@ my @values;
 for (1,2) { for (\(1+3)) { push @values, $$_; $$_++ } }
 is "@values", "4 4",
    '\1+3 folding making modification affect future retvals';
+
+{
+    BEGIN { $^W = 0; $::{u} = \undef }
+    my $w;
+    local $SIG{__WARN__} = sub { ++$w };
+    () = 1 + u;
+    is $w, 1, '1+undef_constant is not folded outside warninsg scope';
+    BEGIN { $^W = 1 }
+}

diff --git a/t/op/coresubs.t b/t/op/coresubs.t
index 58f7d5f..36a6a10 100644 (file)
--- a/t/op/coresubs.t
+++ b/t/op/coresubs.t
@@ -80,6 +80,9 @@ while(<$kh>) {
       }
       if ($hpcode) {
          $tests ++;
+         # __FILE__ won’t fold with warnings on, and then we get
+         # ‘(eval 21)’ vs ‘(eval 22)’.
+         no warnings 'numeric';
          $core = $bd->coderef2text(eval $hpcode =~ s/my/CORE::/r or die);
          $my   = $bd->coderef2text(eval $hpcode or die);
          is $my, $core, "precedence of CORE::$word without parens";