move Perl_ck_warner() before unwind [perl #113794]
authorZefram <zefram@fysh.org>
Tue, 23 Apr 2013 14:30:46 +0000 (10:30 -0400)
committerRicardo Signes <rjbs@cpan.org>
Wed, 24 Apr 2013 14:13:54 +0000 (10:13 -0400)
Indeed. The Perl_ck_warner() call in die_unwind() used to happen
before unwinding, so would be affected by the lexical warning state
at the die() site. Now it happens after unwinding, so takes the
lexical warning state at the catching site. I don't have a clear
idea of which behaviour is more correct. t/op/die_keeperr.t, which
was introduced as part of my exception handling changes, is actually
testing for the catching-site criterion, but that's not asserting
that the criterion should be that.  The documentation speaks of "no
warnings 'misc'", but doesn't say which lexical scope matters.

Assuming we want to revert this change, the easy fix is to move the
conditional Perl_ck_warner() back to before unwinding. A more
difficult way would be to determine the disposition of the warning
before unwinding and then warn in the required manner after
unwinding.  I see no compelling reason to warn after unwinding
rather than before, so just moving the warning code should be fine.

Note from the committer: This patch was supplied by Zefram in
https://rt.perl.org/rt3/Ticket/Display.html?id=113794#txn-1204749
with a note that some extra work was required for
ext/XS-APItest/t/call.t before the job was done.  Ricardo Signes
applied this patch and followed Zefram's lead in patching
ext/XS-APItest/t/call.t without being 100% certain that this was
what was meant.  This commit was then submitted for review.

ext/XS-APItest/t/call.t
pp_ctl.c
t/op/die_keeperr.t

index fd968b8..7ff9933 100644 (file)
@@ -186,9 +186,10 @@ foreach my $inx ("", "aabbcc\n", [qw(aa bb cc)]) {
 }
 
 {
+    no warnings "misc";
     my $warn = "";
     local $SIG{__WARN__} = sub { $warn .= $_[0] };
-    call_sv(sub { no warnings "misc"; die "aa\n" }, G_VOID|G_EVAL|G_KEEPERR);
+    call_sv(sub { use warnings "misc"; die "aa\n" }, G_VOID|G_EVAL|G_KEEPERR);
     is $warn, "\t(in cleanup) aa\n";
 }
 
index bdbd75a..aae200f 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1653,6 +1653,11 @@ Perl_die_unwind(pTHX_ SV *msv)
            sv_setsv(ERRSV, exceptsv);
        }
 
+       if (in_eval & EVAL_KEEPERR) {
+           Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %"SVf,
+                          SVfARG(exceptsv));
+       }
+
        while ((cxix = dopoptoeval(cxstack_ix)) < 0
               && PL_curstackinfo->si_prev)
        {
@@ -1711,13 +1716,8 @@ Perl_die_unwind(pTHX_ SV *msv)
                           SVfARG(exceptsv ? exceptsv : newSVpvs_flags("Unknown error\n",
                                                                     SVs_TEMP)));
            }
-           if (in_eval & EVAL_KEEPERR) {
-               Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %"SVf,
-                              SVfARG(exceptsv));
-           }
-           else {
+           if (!(in_eval & EVAL_KEEPERR))
                sv_setsv(ERRSV, exceptsv);
-           }
            PL_restartjmpenv = restartjmpenv;
            PL_restartop = restartop;
            JMPENV_JUMP(3);
index 9b41cb5..083bd5d 100644 (file)
@@ -3,7 +3,7 @@
 BEGIN {
     chdir 't' if -d 't';
     require 'test.pl';
-    plan(20);
+    plan(24);
 }
 
 sub End::DESTROY { $_[0]->() }
@@ -31,14 +31,45 @@ foreach my $inx ("", "aabbcc\n", [qw(aa bb cc)]) {
     no warnings "misc";
     my $warn = "";
     local $SIG{__WARN__} = sub { $warn .= $_[0] };
-    { my $e = end { die "aa\n"; }; }
+    { my $e = end { no warnings "misc"; die "aa\n"; }; }
     is $warn, "";
 }
 
 {
+    no warnings "misc";
+    my $warn = "";
+    local $SIG{__WARN__} = sub { $warn .= $_[0] };
+    { my $e = end { use warnings "misc"; die "aa\n"; }; }
+    is $warn, "\t(in cleanup) aa\n";
+}
+
+{
     my $warn = "";
     local $SIG{__WARN__} = sub { $warn .= $_[0] };
     { my $e = end { no warnings "misc"; die "aa\n"; }; }
+    is $warn, "";
+}
+
+{
+    my $warn = "";
+    local $SIG{__WARN__} = sub { $warn .= $_[0] };
+    { my $e = end { use warnings "misc"; die "aa\n"; }; }
+    is $warn, "\t(in cleanup) aa\n";
+}
+
+{
+    use warnings "misc";
+    my $warn = "";
+    local $SIG{__WARN__} = sub { $warn .= $_[0] };
+    { my $e = end { no warnings "misc"; die "aa\n"; }; }
+    is $warn, "";
+}
+
+{
+    use warnings "misc";
+    my $warn = "";
+    local $SIG{__WARN__} = sub { $warn .= $_[0] };
+    { my $e = end { use warnings "misc"; die "aa\n"; }; }
     is $warn, "\t(in cleanup) aa\n";
 }