package warnings;
-our $VERSION = "1.48";
+our $VERSION = "1.49";
# Verify that we're called correctly so that warnings will work.
# Can't use Carp, since Carp uses us!
sub import
{
- shift;
-
- my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
+ my $invocant = shift;
# append 'all' when implied (empty import list or after a lone
# "FATAL" or "NONFATAL")
push @_, 'all'
- if !@_ || (@_==1 && ($_[0] eq 'FATAL' || $_[0] eq 'NONFATAL'));
-
- ${^WARNING_BITS} = _bits($mask, @_);
+ if !@_ || (@_==1 && ($_[0] eq 'FATAL' || $_[0] eq 'NONFATAL'));
+
+ my @fatal = ();
+ foreach my $warning (@_) {
+ if($warning =~ /^(NON)?FATAL$/) {
+ @fatal = ($warning);
+ } elsif(substr($warning, 0, 1) ne '-') {
+ my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
+ ${^WARNING_BITS} = _bits($mask, @fatal, $warning);
+ } else {
+ $invocant->unimport(substr($warning, 1));
+ }
+ }
}
sub unimport
no warnings;
use warnings "all";
- no warnings "all";
+ no warnings "uninitialized";
+
+ # or equivalent to those last two ...
+ use warnings qw(all -uninitialized);
use warnings::register;
if (warnings::enabled()) {
Note that neither the B<-w> flag or the C<$^W> can be used to
disable/enable default warnings. They are still mandatory in this case.
+=head2 "Negative warnings"
+
+As a convenience, you can (as of Perl 5.34) pass arguments to the
+C<import()> method both positively and negatively. Negative warnings
+are those with a C<-> sign prepended to their names; positive warnings
+are anything else. This lets you turn on some warnings and turn off
+others in one command. So, assuming that you've already turned on a
+bunch of warnings but want to tweak them a bit in some block, you can
+do this:
+
+ {
+ use warnings qw(uninitialized -redefine);
+ ...
+ }
+
+which is equivalent to:
+
+ {
+ use warnings qw(uninitialized);
+ no warnings qw(redefine);
+ ...
+ }
+
+The argument list is processed in the order you specify. So, for example, if you
+don't want to be warned about use of experimental features, except for C<somefeature>
+that you really dislike, you can say this:
+
+ use warnings qw(all -experimental experimental::somefeature);
+
+which is equivalent to:
+
+ use warnings 'all';
+ no warnings 'experimental';
+ use warnings 'experimental::somefeature';
+
=head2 What's wrong with B<-w> and C<$^W>
Although very useful, the big problem with using B<-w> on the command
#
# This script is normally invoked from regen.pl.
-$VERSION = '1.48';
+$VERSION = '1.49';
BEGIN {
require './regen/regen_lib.pl';
sub import
{
- shift;
-
- my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
+ my $invocant = shift;
# append 'all' when implied (empty import list or after a lone
# "FATAL" or "NONFATAL")
push @_, 'all'
- if !@_ || (@_==1 && ($_[0] eq 'FATAL' || $_[0] eq 'NONFATAL'));
-
- ${^WARNING_BITS} = _bits($mask, @_);
+ if !@_ || (@_==1 && ($_[0] eq 'FATAL' || $_[0] eq 'NONFATAL'));
+
+ my @fatal = ();
+ foreach my $warning (@_) {
+ if($warning =~ /^(NON)?FATAL$/) {
+ @fatal = ($warning);
+ } elsif(substr($warning, 0, 1) ne '-') {
+ my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
+ ${^WARNING_BITS} = _bits($mask, @fatal, $warning);
+ } else {
+ $invocant->unimport(substr($warning, 1));
+ }
+ }
}
sub unimport
no warnings;
use warnings "all";
- no warnings "all";
+ no warnings "uninitialized";
+
+ # or equivalent to those last two ...
+ use warnings qw(all -uninitialized);
use warnings::register;
if (warnings::enabled()) {
Note that neither the B<-w> flag or the C<$^W> can be used to
disable/enable default warnings. They are still mandatory in this case.
+=head2 "Negative warnings"
+
+As a convenience, you can (as of Perl 5.34) pass arguments to the
+C<import()> method both positively and negatively. Negative warnings
+are those with a C<-> sign prepended to their names; positive warnings
+are anything else. This lets you turn on some warnings and turn off
+others in one command. So, assuming that you've already turned on a
+bunch of warnings but want to tweak them a bit in some block, you can
+do this:
+
+ {
+ use warnings qw(uninitialized -redefine);
+ ...
+ }
+
+which is equivalent to:
+
+ {
+ use warnings qw(uninitialized);
+ no warnings qw(redefine);
+ ...
+ }
+
+The argument list is processed in the order you specify. So, for example, if you
+don't want to be warned about use of experimental features, except for C<somefeature>
+that you really dislike, you can say this:
+
+ use warnings qw(all -experimental experimental::somefeature);
+
+which is equivalent to:
+
+ use warnings 'all';
+ no warnings 'experimental';
+ use warnings 'experimental::somefeature';
+
=head2 What's wrong with B<-w> and C<$^W>
Although very useful, the big problem with using B<-w> on the command
Useless use of a constant ("foobar") in void context at - line 3.
########
+# Check -negative import with no other args
+use warnings qw(-syntax);
+sub foo { 'foo' }
+my $a =+ 1 ; # syntax: shouldn't warn, it was never turned on
+*foo = sub { 'bar' }; # redefine: shouldn't warn, it was never turned on
+$a = 'foo' . undef; # uninitialized: shouldn't warn, it was never turned on
+EXPECT
+########
+
+# Check -negative import after turning all warnings on
+use warnings qw(all -syntax);
+sub foo { 'foo' }
+my $a =+ 1 ; # syntax: shouldn't warn, we've turned that off
+*foo = sub { 'bar' }; # redefine: should warn, as there was an explicit 'all'
+$a = 'foo' . undef; # uninitialized: should warn, as there was an explicit 'all'
+EXPECT
+Subroutine main::foo redefined at - line 6.
+Use of uninitialized value in concatenation (.) or string at - line 7.
+########
+
+# Check -negative import with an explicit import
+use warnings qw(redefine -syntax);
+sub foo { 'foo' }
+my $a =+ 1 ; # syntax: shouldn't warn, it was never turned on
+*foo = sub { 'bar' }; # redefine: should warn, as there was an explicit 'redefine'
+$a = 'foo' . undef; # uninitialized: shouldn't warn, as explicit 'redefine' means no implicit 'all'
+EXPECT
+Subroutine main::foo redefined at - line 6.
+########
+
+# Check multiple -negative imports
+use warnings qw(all -syntax -uninitialized);
+sub foo { 'foo' }
+my $a =+ 1 ; # syntax: shouldn't warn, we've turned that off
+*foo = sub { 'bar' }; # redefine: should warn, as there was an explicit 'all'
+$a = 'foo' . undef; # uninitialized: shouldn't warn, we've turned it off
+EXPECT
+Subroutine main::foo redefined at - line 6.
+########
+
+# Check mixed list of +ve and -ve imports
+use warnings qw(all -once -syntax parenthesis);
+sub foo { 'foo' }
+*foo = sub { 'bar' }; # redefined: should warn, as it was turned on by 'all'
+my $a =+ 1 ; # syntax: shouldn't warn, we've turned that off
+my $foo, $bar = @_; # parenthesis: should warn, as we turned that back on after disabling 'syntax'
+EXPECT
+Parentheses missing around "my" list at - line 7.
+Subroutine main::foo redefined at - line 5.
+########
+
--FILE-- abc
my $a =+ 1 ;
1;
https://perl5.git.perl.org / perl5.git / commitdiff