diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 1999-08-29 10:18:59 +0000 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 1999-08-29 10:18:59 +0000 |
commit | 4438c4b75b842b6c829a7da9841e97abb875b1d8 (patch) | |
tree | 559b1a700465df1cb1ae02ada9b9c9e48dd9539f /lib/warning.pm | |
parent | 6dd159d1401b9b9973dd00c1235374efbcb27144 (diff) | |
download | perl-4438c4b75b842b6c829a7da9841e97abb875b1d8.tar.gz |
Rename warning to warnings, from Paul Marquess.
p4raw-id: //depot/cfgperl@4038
Diffstat (limited to 'lib/warning.pm')
-rw-r--r-- | lib/warning.pm | 169 |
1 files changed, 0 insertions, 169 deletions
diff --git a/lib/warning.pm b/lib/warning.pm deleted file mode 100644 index 70ed91e56c..0000000000 --- a/lib/warning.pm +++ /dev/null @@ -1,169 +0,0 @@ - -# This file was created by warning.pl -# Any changes made here will be lost. -# - -package warning; - -=head1 NAME - -warning - Perl pragma to control optional warnings - -=head1 SYNOPSIS - - use warning; - no warning; - - use warning "all"; - no warning "all"; - -=head1 DESCRIPTION - -If no import list is supplied, all possible warnings are either enabled -or disabled. - -See L<perlmod/Pragmatic Modules> and L<perllexwarn>. - - -=cut - -use Carp ; - -%Bits = ( - 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..35] - 'ambiguous' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [16] - 'closed' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [1] - 'closure' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [27] - 'debugging' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [12] - 'deprecated' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [17] - 'digit' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [18] - 'exec' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [2] - 'inplace' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [13] - 'internal' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [14] - 'io' => "\x55\x05\x00\x00\x00\x00\x00\x00\x00", # [0..5] - 'misc' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [6] - 'newline' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [3] - 'numeric' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [7] - 'octal' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [19] - 'once' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [8] - 'overflow' => "\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [28] - 'parenthesis' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [20] - 'pipe' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [4] - 'portable' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [29] - 'precedence' => "\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [21] - 'printf' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [22] - 'recursion' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [9] - 'redefine' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [10] - 'reserved' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [23] - 'semicolon' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [24] - 'severe' => "\x00\x00\x40\x15\x00\x00\x00\x00\x00", # [11..14] - 'signal' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [30] - 'substr' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [31] - 'syntax' => "\x00\x00\x00\x40\x55\x55\x01\x00\x00", # [15..24] - 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [32] - 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [25] - 'unopened' => "\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [5] - 'unsafe' => "\x00\x00\x00\x00\x00\x00\x50\x55\x15", # [26..34] - 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [33] - 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [34] - 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [35] - ); - -%DeadBits = ( - 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..35] - 'ambiguous' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [16] - 'closed' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [1] - 'closure' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [27] - 'debugging' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [12] - 'deprecated' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [17] - 'digit' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [18] - 'exec' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [2] - 'inplace' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [13] - 'internal' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [14] - 'io' => "\xaa\x0a\x00\x00\x00\x00\x00\x00\x00", # [0..5] - 'misc' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [6] - 'newline' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [3] - 'numeric' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [7] - 'octal' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [19] - 'once' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [8] - 'overflow' => "\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [28] - 'parenthesis' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [20] - 'pipe' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [4] - 'portable' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [29] - 'precedence' => "\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [21] - 'printf' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [22] - 'recursion' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [9] - 'redefine' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [10] - 'reserved' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [23] - 'semicolon' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [24] - 'severe' => "\x00\x00\x80\x2a\x00\x00\x00\x00\x00", # [11..14] - 'signal' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [30] - 'substr' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [31] - 'syntax' => "\x00\x00\x00\x80\xaa\xaa\x02\x00\x00", # [15..24] - 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [32] - 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [25] - 'unopened' => "\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [5] - 'unsafe' => "\x00\x00\x00\x00\x00\x00\xa0\xaa\x2a", # [26..34] - 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [33] - 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [34] - 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [35] - ); - - -sub bits { - my $mask ; - 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 ; - } - else - { croak "unknown warning category '$word'" } - } - - return $mask ; -} - -sub import { - shift; - $^B |= bits(@_ ? @_ : 'all') ; -} - -sub unimport { - shift; - $^B &= ~ bits(@_ ? @_ : 'all') ; -} - - -sub make_fatal -{ - my $self = shift ; - my $bitmask = $self->bits(@_) ; - $SIG{__WARN__} = - sub - { - die @_ if $^B & $bitmask ; - warn @_ - } ; -} - -sub bitmask -{ - return $^B ; -} - -sub enabled -{ - my $string = shift ; - - return 1 - if $bits{$string} && $^B & $bits{$string} ; - - return 0 ; -} - -1; |