This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
lexical warnings; tweaks to places that didn't apply correctly
[perl5.git] / lib / warning.pm
CommitLineData
599cee73
PM
1
2# This file was created by warning.pl
3# Any changes made here will be lost.
4#
5
6package warning;
7
8=head1 NAME
9
10warning - Perl pragma to control
11
12=head1 SYNOPSIS
13
14 use warning;
15
16 use warning "all";
17 use warning "deprecated";
18
19 use warning;
20 no warning "unsafe";
21
22=head1 DESCRIPTION
23
24If no import list is supplied, all possible restrictions are assumed.
25(This is the safest mode to operate in, but is sometimes too strict for
26casual programming.) Currently, there are three possible things to be
27strict about:
28
29=over 6
30
31=item C<warning deprecated>
32
33This generates a runtime error if you use deprecated
34
35 use warning 'deprecated';
36
37=back
38
39See L<perlmod/Pragmatic Modules>.
40
41
42=cut
43
44use Carp ;
45
46%Bits = (
47 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55", # [0..31]
48 'ambiguous' => "\x00\x00\x00\x00\x10\x00\x00\x00", # [18]
49 'closed' => "\x00\x00\x00\x00\x00\x40\x00\x00", # [23]
50 'closure' => "\x00\x04\x00\x00\x00\x00\x00\x00", # [5]
51 'default' => "\x00\x00\x10\x00\x00\x00\x00\x00", # [10]
52 'deprecated' => "\x00\x00\x00\x10\x00\x00\x00\x00", # [14]
53 'exec' => "\x00\x00\x00\x00\x00\x00\x01\x00", # [24]
54 'io' => "\x00\x00\x00\x00\x00\x54\x15\x00", # [21..26]
55 'misc' => "\x00\x00\x00\x00\x00\x00\x00\x04", # [29]
56 'newline' => "\x00\x00\x00\x00\x00\x10\x00\x00", # [22]
57 'numeric' => "\x00\x00\x04\x00\x00\x00\x00\x00", # [9]
58 'octal' => "\x00\x00\x00\x00\x04\x00\x00\x00", # [17]
59 'once' => "\x00\x00\x40\x00\x00\x00\x00\x00", # [11]
60 'parenthesis' => "\x00\x00\x00\x00\x40\x00\x00\x00", # [19]
61 'pipe' => "\x00\x00\x00\x00\x00\x00\x10\x00", # [26]
62 'precedence' => "\x00\x00\x00\x00\x00\x01\x00\x00", # [20]
63 'printf' => "\x00\x00\x00\x00\x01\x00\x00\x00", # [16]
64 'recursion' => "\x00\x00\x00\x00\x00\x00\x00\x01", # [28]
65 'redefine' => "\x01\x00\x00\x00\x00\x00\x00\x00", # [0]
66 'reserved' => "\x00\x00\x00\x04\x00\x00\x00\x00", # [13]
67 'semicolon' => "\x00\x00\x00\x40\x00\x00\x00\x00", # [15]
68 'signal' => "\x00\x40\x00\x00\x00\x00\x00\x00", # [7]
69 'substr' => "\x00\x01\x00\x00\x00\x00\x00\x00", # [4]
70 'syntax' => "\x00\x00\x00\x55\x55\x01\x00\x00", # [12..20]
71 'taint' => "\x40\x00\x00\x00\x00\x00\x00\x00", # [3]
72 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x40\x00", # [27]
73 'unopened' => "\x00\x00\x00\x00\x00\x00\x04\x00", # [25]
74 'unsafe' => "\x50\x55\x01\x00\x00\x00\x00\x00", # [2..8]
75 'untie' => "\x00\x10\x00\x00\x00\x00\x00\x00", # [6]
76 'utf8' => "\x00\x00\x01\x00\x00\x00\x00\x00", # [8]
77 'void' => "\x04\x00\x00\x00\x00\x00\x00\x00", # [1]
78 );
79
80%DeadBits = (
81 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..31]
82 'ambiguous' => "\x00\x00\x00\x00\x20\x00\x00\x00", # [18]
83 'closed' => "\x00\x00\x00\x00\x00\x80\x00\x00", # [23]
84 'closure' => "\x00\x08\x00\x00\x00\x00\x00\x00", # [5]
85 'default' => "\x00\x00\x20\x00\x00\x00\x00\x00", # [10]
86 'deprecated' => "\x00\x00\x00\x20\x00\x00\x00\x00", # [14]
87 'exec' => "\x00\x00\x00\x00\x00\x00\x02\x00", # [24]
88 'io' => "\x00\x00\x00\x00\x00\xa8\x2a\x00", # [21..26]
89 'misc' => "\x00\x00\x00\x00\x00\x00\x00\x08", # [29]
90 'newline' => "\x00\x00\x00\x00\x00\x20\x00\x00", # [22]
91 'numeric' => "\x00\x00\x08\x00\x00\x00\x00\x00", # [9]
92 'octal' => "\x00\x00\x00\x00\x08\x00\x00\x00", # [17]
93 'once' => "\x00\x00\x80\x00\x00\x00\x00\x00", # [11]
94 'parenthesis' => "\x00\x00\x00\x00\x80\x00\x00\x00", # [19]
95 'pipe' => "\x00\x00\x00\x00\x00\x00\x20\x00", # [26]
96 'precedence' => "\x00\x00\x00\x00\x00\x02\x00\x00", # [20]
97 'printf' => "\x00\x00\x00\x00\x02\x00\x00\x00", # [16]
98 'recursion' => "\x00\x00\x00\x00\x00\x00\x00\x02", # [28]
99 'redefine' => "\x02\x00\x00\x00\x00\x00\x00\x00", # [0]
100 'reserved' => "\x00\x00\x00\x08\x00\x00\x00\x00", # [13]
101 'semicolon' => "\x00\x00\x00\x80\x00\x00\x00\x00", # [15]
102 'signal' => "\x00\x80\x00\x00\x00\x00\x00\x00", # [7]
103 'substr' => "\x00\x02\x00\x00\x00\x00\x00\x00", # [4]
104 'syntax' => "\x00\x00\x00\xaa\xaa\x02\x00\x00", # [12..20]
105 'taint' => "\x80\x00\x00\x00\x00\x00\x00\x00", # [3]
106 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x80\x00", # [27]
107 'unopened' => "\x00\x00\x00\x00\x00\x00\x08\x00", # [25]
108 'unsafe' => "\xa0\xaa\x02\x00\x00\x00\x00\x00", # [2..8]
109 'untie' => "\x00\x20\x00\x00\x00\x00\x00\x00", # [6]
110 'utf8' => "\x00\x00\x02\x00\x00\x00\x00\x00", # [8]
111 'void' => "\x08\x00\x00\x00\x00\x00\x00\x00", # [1]
112 );
113
114
115sub bits {
116 my $mask ;
117 my $catmask ;
118 my $fatal = 0 ;
119 foreach my $word (@_) {
120 if ($word eq 'FATAL')
121 { $fatal = 1 }
122 elsif ($catmask = $Bits{$word}) {
123 $mask |= $catmask ;
124 $mask |= $DeadBits{$word} if $fatal ;
125 }
126 else
127 { croak "unknown warning category '$word'" }
128 }
129
130 return $mask ;
131}
132
133sub import {
134 shift;
135 $^B |= bits(@_ ? @_ : 'all') ;
136}
137
138sub unimport {
139 shift;
140 $^B &= ~ bits(@_ ? @_ : 'all') ;
141}
142
143
144sub make_fatal
145{
146 my $self = shift ;
147 my $bitmask = $self->bits(@_) ;
148 $SIG{__WARN__} =
149 sub
150 {
151 die @_ if $^B & $bitmask ;
152 warn @_
153 } ;
154}
155
156sub bitmask
157{
158 return $^B ;
159}
160
161sub enabled
162{
163 my $string = shift ;
164
165 return 1
166 if $bits{$string} && $^B & $bits{$string} ;
167
168 return 0 ;
169}
170
1711;