diff options
| -rw-r--r-- | lib/warnings.pm | 62 | ||||
| -rw-r--r-- | regen/warnings.pl | 62 | ||||
| -rw-r--r-- | t/lib/warnings/2use | 51 |
3 files changed, 159 insertions, 16 deletions
diff --git a/lib/warnings.pm b/lib/warnings.pm index 595792cd8e..6f3420b8dd 100644 --- a/lib/warnings.pm +++ b/lib/warnings.pm @@ -5,7 +5,7 @@ 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! @@ -335,16 +335,24 @@ sub bits 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 @@ -571,7 +579,10 @@ warnings - Perl pragma to control optional warnings 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()) { @@ -658,6 +669,41 @@ be reported for the C<$x> variable. 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 diff --git a/regen/warnings.pl b/regen/warnings.pl index cf07974693..498b93e285 100644 --- a/regen/warnings.pl +++ b/regen/warnings.pl @@ -16,7 +16,7 @@ # # This script is normally invoked from regen.pl. -$VERSION = '1.48'; +$VERSION = '1.49'; BEGIN { require './regen/regen_lib.pl'; @@ -639,16 +639,24 @@ sub bits 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 @@ -875,7 +883,10 @@ warnings - Perl pragma to control optional warnings 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()) { @@ -962,6 +973,41 @@ be reported for the C<$x> variable. 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 diff --git a/t/lib/warnings/2use b/t/lib/warnings/2use index 4df98e2baa..f66b758a58 100644 --- a/t/lib/warnings/2use +++ b/t/lib/warnings/2use @@ -79,6 +79,57 @@ EXPECT 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; |