future-proof unknown warning categories (from Greg Bacon

<gbacon@cs.uah.edu>)

p4raw-id: //depot/perl@4947

diff --git a/lib/warnings.pm b/lib/warnings.pm
index e15d364..977395b 100644 (file)
--- a/lib/warnings.pm
+++ b/lib/warnings.pm
@@ -115,14 +115,15 @@ sub bits {
     my $catmask ;
     my $fatal = 0 ;
     foreach my $word (@_) {
-       if  ($word eq 'FATAL')
-         { $fatal = 1 }
-       elsif ($catmask = $Bits{$word}) {
-         $mask |= $catmask ;
-         $mask |= $DeadBits{$word} if $fatal ;
+       if  ($word eq 'FATAL') {
+           $fatal = 1;
+       }
+       else {
+           if ($catmask = $Bits{$word}) {
+               $mask |= $catmask ;
+               $mask |= $DeadBits{$word} if $fatal ;
+           }
        }
-       else
-         { croak "unknown warning category '$word'" }
     }
 
     return $mask ;

diff --git a/t/pragma/warn/2use b/t/pragma/warn/2use
index 384b3b3..396f201 100644 (file)
--- a/t/pragma/warn/2use
+++ b/t/pragma/warn/2use
@@ -5,11 +5,9 @@ TODO
 
 __END__
 
-# check illegal category is caught
-use warnings 'blah' ;
+# ignore unknown warning categories
+use warnings 'this-should-never-be-a-warning-category' ;
 EXPECT
-unknown warning category 'blah' at - line 3
-BEGIN failed--compilation aborted at - line 3.
 ########
 
 # Check compile time scope of pragma

diff --git a/warnings.pl b/warnings.pl
index 72d19af..8d3450b 100644 (file)
--- a/warnings.pl
+++ b/warnings.pl
@@ -300,14 +300,15 @@ sub bits {
     my $catmask ;
     my $fatal = 0 ;
     foreach my $word (@_) {
-       if  ($word eq 'FATAL')
-         { $fatal = 1 }
-       elsif ($catmask = $Bits{$word}) {
-         $mask |= $catmask ;
-         $mask |= $DeadBits{$word} if $fatal ;
+       if  ($word eq 'FATAL') {
+           $fatal = 1;
+       }
+       else {
+           if ($catmask = $Bits{$word}) {
+               $mask |= $catmask ;
+               $mask |= $DeadBits{$word} if $fatal ;
+           }
        }
-       else
-         { croak "unknown warning category '$word'" }
     }
 
     return $mask ;