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 while (($k, $v) = each %$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} } ;
76 ###########################################################################
85 for ($i = 1 ; $i < @a; ++ $i) {
87 if $a[$i] == $a[$i - 1] + 1 && $a[$i] + 1 == $a[$i + 1] ;
90 my $out = join(",",@out);
92 $out =~ s/,(\.\.,)+/../g ;
96 ###########################################################################
101 my $mask = "\x00" x $max ;
105 vec($mask, $_, 1) = 1 ;
108 #$string = unpack("H$max", $mask) ;
109 #$string =~ s/(..)/\x$1/g;
110 foreach (unpack("C*", $mask)) {
111 $string .= '\x' . sprintf("%2.2x", $_) ;
116 ###########################################################################
120 #unlink "lib/warning.pm";
121 open(WARN, ">warning.h") || die "Can't create warning.h: $!\n";
122 open(PM, ">lib/warning.pm") || die "Can't create lib/warning.pm: $!\n";
125 /* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
126 This file is built by warning.pl
127 Any changes made here will be lost!
131 #define Off(x) ((x) / 8)
132 #define Bit(x) (1 << ((x) % 8))
133 #define IsSet(a, x) ((a)[Off(x)] & Bit(x))
135 #define G_WARN_OFF 0 /* $^W == 0 */
136 #define G_WARN_ON 1 /* $^W != 0 */
137 #define G_WARN_ALL_ON 2 /* -W flag */
138 #define G_WARN_ALL_OFF 4 /* -X flag */
139 #define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF)
143 /* Part of the logic below assumes that WARN_NONE is NULL */
146 (PL_curcop->cop_warnings != WARN_ALL && \
147 PL_curcop->cop_warnings != WARN_NONE && \
148 IsSet(SvPVX(PL_curcop->cop_warnings), 2*x+1))
151 ( (PL_curcop->cop_warnings && \
152 (PL_curcop->cop_warnings == WARN_ALL || \
153 IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) ) ) \
154 || (PL_dowarn & G_WARN_ON) )
156 #define ckWARN2(x,y) \
157 ( (PL_curcop->cop_warnings && \
158 (PL_curcop->cop_warnings == WARN_ALL || \
159 IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) || \
160 IsSet(SvPVX(PL_curcop->cop_warnings), 2*y) ) ) \
161 || (PL_dowarn & G_WARN_ON) )
166 (PL_curcop->cop_warnings != WARN_ALL && \
167 PL_curcop->cop_warnings != WARN_NONE && \
168 SvPVX(PL_curcop->cop_warnings)[Off(2*x+1)] & Bit(2*x+1) )
171 ( (PL_dowarn & G_WARN_ON) || ( (PL_dowarn & G_WARN_DISABLE) && \
172 PL_curcop->cop_warnings && \
173 ( PL_curcop->cop_warnings == WARN_ALL || \
174 SvPVX(PL_curcop->cop_warnings)[Off(2*x)] & Bit(2*x) ) ) )
176 #define ckWARN2(x,y) \
177 ( (PL_dowarn & G_WARN_ON) || ( (PL_dowarn & G_WARN_DISABLE) && \
178 PL_curcop->cop_warnings && \
179 ( PL_curcop->cop_warnings == WARN_ALL || \
180 SvPVX(PL_curcop->cop_warnings)[Off(2*x)] & Bit(2*x) || \
181 SvPVX(PL_curcop->cop_warnings)[Off(2*y)] & Bit(2*y) ) ) )
185 #define WARN_NONE NULL
186 #define WARN_ALL (&PL_sv_yes)
192 @{ $list{"all"} } = walk ($tree) ;
195 my $warn_size = int($index / 8) + ($index % 8 != 0) ;
198 foreach $k (sort { $a <=> $b } keys %Value) {
199 print WARN tab(5, "#define WARN_$Value{$k}"), "$k\n" ;
203 print WARN tab(5, '#define WARNsize'), "$warn_size\n" ;
204 #print WARN tab(5, '#define WARN_ALLstring'), '"', ('\377' x $warn_size) , "\"\n" ;
205 print WARN tab(5, '#define WARN_ALLstring'), '"', ('\125' x $warn_size) , "\"\n" ;
206 print WARN tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) , "\"\n" ;
210 /* end of file warning.h */
217 last if /^KEYWORDS$/ ;
221 $list{'all'} = [ 0 .. 8 * ($warn_size/2) - 1 ] ;
222 print PM "%Bits = (\n" ;
223 foreach $k (sort keys %list) {
226 my @list = sort { $a <=> $b } @$v ;
228 print PM tab(4, " '$k'"), '=> "',
229 # mkHex($warn_size, @list),
230 mkHex($warn_size, map $_ * 2 , @list),
231 '", # [', mkRange(@list), "]\n" ;
236 print PM "%DeadBits = (\n" ;
237 foreach $k (sort keys %list) {
240 my @list = sort { $a <=> $b } @$v ;
242 print PM tab(4, " '$k'"), '=> "',
243 # mkHex($warn_size, @list),
244 mkHex($warn_size, map $_ * 2 + 1 , @list),
245 '", # [', mkRange(@list), "]\n" ;
257 # This file was created by warning.pl
258 # Any changes made here will be lost.
265 warning - Perl pragma to control
272 use warning "deprecated";
279 If no import list is supplied, all possible restrictions are assumed.
280 (This is the safest mode to operate in, but is sometimes too strict for
281 casual programming.) Currently, there are three possible things to be
286 =item C<warning deprecated>
288 This generates a runtime error if you use deprecated
290 use warning 'deprecated';
294 See L<perlmod/Pragmatic Modules>.
307 foreach my $word (@_) {
308 if ($word eq 'FATAL')
310 elsif ($catmask = $Bits{$word}) {
312 $mask |= $DeadBits{$word} if $fatal ;
315 { croak "unknown warning category '$word'" }
323 $^B |= bits(@_ ? @_ : 'all') ;
328 $^B &= ~ bits(@_ ? @_ : 'all') ;
335 my $bitmask = $self->bits(@_) ;
339 die @_ if $^B & $bitmask ;
354 if $bits{$string} && $^B & $bits{$string} ;