This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make newCONSTSUB use the right warning scope.
authorFather Chrysostomos <sprout@cpan.org>
Mon, 21 Nov 2011 08:06:23 +0000 (00:06 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 21 Nov 2011 08:32:32 +0000 (00:32 -0800)
newCONSTSUB uses the compile-time warning hints, instead of the run-
time hints.  This means that

  use warnings;
  BEGIN {
    no warnings;
    some_XS_function_that_calls_new_CONSTSUB();
  }

may trigger a redefinition warning, whereas it should be analogous to

  use warnings;
  BEGIN {
    no warnings;
    *foo = \&bar;
  }

which does not warn.

newCONSTSUB localises PL_curcop and sets it to &PL_compiling.  When it
does that, it needs to copy the hints over.

Running tests inside eval is not reliable without a test count, so I
added one.

ext/XS-APItest/t/newCONSTSUB.t
op.c

index 4a2edd6..286f9a2 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 use utf8;
 use open qw( :utf8 :std );
-use Test::More "no_plan";
+use Test::More tests => 9;
 
 use XS::APItest;
 
@@ -22,3 +22,14 @@ ok !$::{"\x{30cb}"}, "...but not the right one";
 ok $const, "newCONSTSUB_flags generates the constant,";
 ok *{$glob}{CODE}, "..and the glob,";
 ok $::{"\x{30cd}"}, "...the right one!";
+
+eval q{
+ BEGIN {
+  no warnings;
+  my $w;
+  local $SIG{__WARN__} = sub { $w .= shift };
+  *foo = sub(){123};
+  newCONSTSUB_type(\%::, "foo", 0, 1);
+  is $w, undef, 'newCONSTSUB uses calling scope for redefinition warnings';
+ }
+};
diff --git a/op.c b/op.c
index 2deedd1..a17dce2 100644 (file)
--- a/op.c
+++ b/op.c
@@ -6938,6 +6938,8 @@ Perl_newCONSTSUB_flags(pTHX_ HV *stash, const char *name, STRLEN len,
         * an op shared between threads. Use a non-shared COP for our
         * dirty work */
         SAVEVPTR(PL_curcop);
+        SAVECOMPILEWARNINGS();
+        PL_compiling.cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings);
         PL_curcop = &PL_compiling;
     }
     SAVECOPLINE(PL_curcop);