5 sub DEFAULT_ON () { 1 }
6 sub DEFAULT_OFF () { 2 }
9 'unsafe' => { 'untie' => DEFAULT_OFF,
10 'substr' => DEFAULT_OFF,
11 'taint' => DEFAULT_OFF,
12 'signal' => DEFAULT_OFF,
13 'closure' => DEFAULT_OFF,
14 'utf8' => DEFAULT_OFF,
16 'io' => { 'pipe' => DEFAULT_OFF,
17 'unopened' => DEFAULT_OFF,
18 'closed' => DEFAULT_OFF,
19 'newline' => DEFAULT_OFF,
20 'exec' => DEFAULT_OFF,
21 #'wr in in file'=> DEFAULT_OFF,
23 'syntax' => { 'ambiguous' => DEFAULT_OFF,
24 'semicolon' => DEFAULT_OFF,
25 'precedence' => DEFAULT_OFF,
26 'reserved' => DEFAULT_OFF,
27 'octal' => DEFAULT_OFF,
28 'parenthesis' => DEFAULT_OFF,
29 'deprecated' => DEFAULT_OFF,
30 'printf' => DEFAULT_OFF,
32 'void' => DEFAULT_OFF,
33 'recursion' => DEFAULT_OFF,
34 'redefine' => DEFAULT_OFF,
35 'numeric' => DEFAULT_OFF,
36 'uninitialized'=> DEFAULT_OFF,
37 'once' => DEFAULT_OFF,
38 'misc' => DEFAULT_OFF,
39 'default' => DEFAULT_ON,
43 ###########################################################################
46 $t .= "\t" x ($l - (length($t) + 1) / 8);
50 ###########################################################################
62 foreach $k (sort keys %$tre) {
64 die "duplicate key $k\n" if defined $list{$k} ;
65 $Value{$index} = uc $k ;
66 push @{ $list{$k} }, $index ++ ;
68 { push (@{ $list{$k} }, walk ($v)) }
69 push @list, @{ $list{$k} } ;
75 ###########################################################################
84 for ($i = 1 ; $i < @a; ++ $i) {
86 if $a[$i] == $a[$i - 1] + 1 && $a[$i] + 1 == $a[$i + 1] ;
89 my $out = join(",",@out);
91 $out =~ s/,(\.\.,)+/../g ;
95 ###########################################################################
100 my $mask = "\x00" x $max ;
104 vec($mask, $_, 1) = 1 ;
107 #$string = unpack("H$max", $mask) ;
108 #$string =~ s/(..)/\x$1/g;
109 foreach (unpack("C*", $mask)) {
110 $string .= '\x' . sprintf("%2.2x", $_) ;
115 ###########################################################################
119 #unlink "lib/warning.pm";
120 open(WARN, ">warning.h") || die "Can't create warning.h: $!\n";
121 open(PM, ">lib/warning.pm") || die "Can't create lib/warning.pm: $!\n";
124 /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
125 This file is built by warning.pl
126 Any changes made here will be lost!
130 #define Off(x) ((x) / 8)
131 #define Bit(x) (1 << ((x) % 8))
132 #define IsSet(a, x) ((a)[Off(x)] & Bit(x))
134 #define G_WARN_OFF 0 /* $^W == 0 */
135 #define G_WARN_ON 1 /* $^W != 0 */
136 #define G_WARN_ALL_ON 2 /* -W flag */
137 #define G_WARN_ALL_OFF 4 /* -X flag */
138 #define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF)
142 /* Part of the logic below assumes that WARN_NONE is NULL */
145 (PL_curcop->cop_warnings != WARN_ALL && \
146 PL_curcop->cop_warnings != WARN_NONE && \
147 IsSet(SvPVX(PL_curcop->cop_warnings), 2*x+1))
150 ( (PL_curcop->cop_warnings && \
151 (PL_curcop->cop_warnings == WARN_ALL || \
152 IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) ) ) \
153 || (PL_dowarn & G_WARN_ON) )
155 #define ckWARN2(x,y) \
156 ( (PL_curcop->cop_warnings && \
157 (PL_curcop->cop_warnings == WARN_ALL || \
158 IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) || \
159 IsSet(SvPVX(PL_curcop->cop_warnings), 2*y) ) ) \
160 || (PL_dowarn & G_WARN_ON) )
165 (PL_curcop->cop_warnings != WARN_ALL && \
166 PL_curcop->cop_warnings != WARN_NONE && \
167 SvPVX(PL_curcop->cop_warnings)[Off(2*x+1)] & Bit(2*x+1) )
170 ( (PL_dowarn & G_WARN_ON) || ( (PL_dowarn & G_WARN_DISABLE) && \
171 PL_curcop->cop_warnings && \
172 ( PL_curcop->cop_warnings == WARN_ALL || \
173 SvPVX(PL_curcop->cop_warnings)[Off(2*x)] & Bit(2*x) ) ) )
175 #define ckWARN2(x,y) \
176 ( (PL_dowarn & G_WARN_ON) || ( (PL_dowarn & G_WARN_DISABLE) && \
177 PL_curcop->cop_warnings && \
178 ( PL_curcop->cop_warnings == WARN_ALL || \
179 SvPVX(PL_curcop->cop_warnings)[Off(2*x)] & Bit(2*x) || \
180 SvPVX(PL_curcop->cop_warnings)[Off(2*y)] & Bit(2*y) ) ) )
184 #define WARN_NONE NULL
185 #define WARN_ALL (&PL_sv_yes)
191 @{ $list{"all"} } = walk ($tree) ;
194 my $warn_size = int($index / 8) + ($index % 8 != 0) ;
197 foreach $k (sort { $a <=> $b } keys %Value) {
198 print WARN tab(5, "#define WARN_$Value{$k}"), "$k\n" ;
202 print WARN tab(5, '#define WARNsize'), "$warn_size\n" ;
203 #print WARN tab(5, '#define WARN_ALLstring'), '"', ('\377' x $warn_size) , "\"\n" ;
204 print WARN tab(5, '#define WARN_ALLstring'), '"', ('\125' x $warn_size) , "\"\n" ;
205 print WARN tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) , "\"\n" ;
209 /* end of file warning.h */
216 last if /^KEYWORDS$/ ;
220 $list{'all'} = [ 0 .. 8 * ($warn_size/2) - 1 ] ;
221 print PM "%Bits = (\n" ;
222 foreach $k (sort keys %list) {
225 my @list = sort { $a <=> $b } @$v ;
227 print PM tab(4, " '$k'"), '=> "',
228 # mkHex($warn_size, @list),
229 mkHex($warn_size, map $_ * 2 , @list),
230 '", # [', mkRange(@list), "]\n" ;
235 print PM "%DeadBits = (\n" ;
236 foreach $k (sort keys %list) {
239 my @list = sort { $a <=> $b } @$v ;
241 print PM tab(4, " '$k'"), '=> "',
242 # mkHex($warn_size, @list),
243 mkHex($warn_size, map $_ * 2 + 1 , @list),
244 '", # [', mkRange(@list), "]\n" ;
256 # This file was created by warning.pl
257 # Any changes made here will be lost.
264 warning - Perl pragma to control
271 use warning "deprecated";
278 If no import list is supplied, all possible restrictions are assumed.
279 (This is the safest mode to operate in, but is sometimes too strict for
280 casual programming.) Currently, there are three possible things to be
285 =item C<warning deprecated>
287 This generates a runtime error if you use deprecated
289 use warning 'deprecated';
293 See L<perlmod/Pragmatic Modules>.
306 foreach my $word (@_) {
307 if ($word eq 'FATAL')
309 elsif ($catmask = $Bits{$word}) {
311 $mask |= $DeadBits{$word} if $fatal ;
314 { croak "unknown warning category '$word'" }
322 $^B |= bits(@_ ? @_ : 'all') ;
327 $^B &= ~ bits(@_ ? @_ : 'all') ;
334 my $bitmask = $self->bits(@_) ;
338 die @_ if $^B & $bitmask ;
353 if $bits{$string} && $^B & $bits{$string} ;