summaryrefslogtreecommitdiff
path: root/lib/warning.pm
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>1999-08-29 10:18:59 +0000
committerJarkko Hietaniemi <jhi@iki.fi>1999-08-29 10:18:59 +0000
commit4438c4b75b842b6c829a7da9841e97abb875b1d8 (patch)
tree559b1a700465df1cb1ae02ada9b9c9e48dd9539f /lib/warning.pm
parent6dd159d1401b9b9973dd00c1235374efbcb27144 (diff)
downloadperl-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.pm169
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;