This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Don't bother prettifying win32/perldll.def
[perl5.git] / regen / warnings.pl
CommitLineData
599cee73 1#!/usr/bin/perl
c4a853d1 2#
6294c161
DM
3# Regenerate (overwriting only if changed):
4#
5# lib/warnings.pm
6# warnings.h
7#
8# from information hardcoded into this script (the $tree hash), plus the
d2ec25a5 9# template for warnings.pm in the DATA section.
6294c161 10#
91efc02c
KW
11# When changing the number of warnings, t/op/caller.t should change to
12# correspond with the value of $BYTES in lib/warnings.pm
8457b38f 13#
6294c161
DM
14# With an argument of 'tree', just dump the contents of $tree and exits.
15# Also accepts the standard regen_lib -q and -v args.
16#
17# This script is normally invoked from regen.pl.
599cee73 18
0febf6c1 19$VERSION = '1.03';
b75c8c73 20
73f0cc2d 21BEGIN {
af001346 22 require 'regen/regen_lib.pl';
b6b9a099 23 push @INC, './lib';
73f0cc2d 24}
599cee73
PM
25use strict ;
26
27sub DEFAULT_ON () { 1 }
28sub DEFAULT_OFF () { 2 }
29
30my $tree = {
ea5519d6
AB
31'everything' => [ 5.021, {
32 'all' => [ 5.008, {
33 'io' => [ 5.008, {
34 'pipe' => [ 5.008, DEFAULT_OFF],
35 'unopened' => [ 5.008, DEFAULT_OFF],
36 'closed' => [ 5.008, DEFAULT_OFF],
37 'newline' => [ 5.008, DEFAULT_OFF],
38 'exec' => [ 5.008, DEFAULT_OFF],
39 'layer' => [ 5.008, DEFAULT_OFF],
40 'syscalls' => [ 5.019, DEFAULT_OFF],
41 }],
42 'syntax' => [ 5.008, {
43 'ambiguous' => [ 5.008, DEFAULT_OFF],
44 'semicolon' => [ 5.008, DEFAULT_OFF],
45 'precedence' => [ 5.008, DEFAULT_OFF],
46 'bareword' => [ 5.008, DEFAULT_OFF],
47 'reserved' => [ 5.008, DEFAULT_OFF],
48 'digit' => [ 5.008, DEFAULT_OFF],
49 'parenthesis' => [ 5.008, DEFAULT_OFF],
50 'printf' => [ 5.008, DEFAULT_OFF],
51 'prototype' => [ 5.008, DEFAULT_OFF],
52 'qw' => [ 5.008, DEFAULT_OFF],
53 'illegalproto' => [ 5.011, DEFAULT_OFF],
54 }],
55 'severe' => [ 5.008, {
56 'inplace' => [ 5.008, DEFAULT_ON],
57 'internal' => [ 5.008, DEFAULT_OFF],
58 'debugging' => [ 5.008, DEFAULT_ON],
59 'malloc' => [ 5.008, DEFAULT_ON],
60 }],
61 'deprecated' => [ 5.008, DEFAULT_ON],
62 'void' => [ 5.008, DEFAULT_OFF],
63 'recursion' => [ 5.008, DEFAULT_OFF],
64 'redefine' => [ 5.008, DEFAULT_OFF],
65 'numeric' => [ 5.008, DEFAULT_OFF],
66 'uninitialized' => [ 5.008, DEFAULT_OFF],
67 'once' => [ 5.008, DEFAULT_OFF],
68 'misc' => [ 5.008, DEFAULT_OFF],
69 'regexp' => [ 5.008, DEFAULT_OFF],
70 'glob' => [ 5.008, DEFAULT_ON],
71 'untie' => [ 5.008, DEFAULT_OFF],
72 'substr' => [ 5.008, DEFAULT_OFF],
73 'taint' => [ 5.008, DEFAULT_OFF],
74 'signal' => [ 5.008, DEFAULT_OFF],
75 'closure' => [ 5.008, DEFAULT_OFF],
76 'overflow' => [ 5.008, DEFAULT_OFF],
77 'portable' => [ 5.008, DEFAULT_OFF],
78 'utf8' => [ 5.008, {
79 'surrogate' => [ 5.013, DEFAULT_OFF],
80 'nonchar' => [ 5.013, DEFAULT_OFF],
81 'non_unicode' => [ 5.013, DEFAULT_OFF],
82 }],
83 'exiting' => [ 5.008, DEFAULT_OFF],
84 'pack' => [ 5.008, DEFAULT_OFF],
85 'unpack' => [ 5.008, DEFAULT_OFF],
86 'threads' => [ 5.008, DEFAULT_OFF],
87 'imprecision' => [ 5.011, DEFAULT_OFF],
88 'experimental' => [ 5.017, {
89 'experimental::lexical_subs' =>
90 [ 5.017, DEFAULT_ON ],
91 'experimental::regex_sets' =>
92 [ 5.017, DEFAULT_ON ],
93 'experimental::lexical_topic' =>
94 [ 5.017, DEFAULT_ON ],
95 'experimental::smartmatch' =>
96 [ 5.017, DEFAULT_ON ],
97 'experimental::postderef' =>
98 [ 5.019, DEFAULT_ON ],
99 'experimental::autoderef' =>
100 [ 5.019, DEFAULT_ON ],
101 'experimental::signatures' =>
102 [ 5.019, DEFAULT_ON ],
103 'experimental::win32_perlio' =>
104 [ 5.021, DEFAULT_ON ],
105 'experimental::refaliasing' =>
106 [ 5.021, DEFAULT_ON ],
a4fbcc27
KW
107 'experimental::re_strict' =>
108 [ 5.021, DEFAULT_ON ],
87ed2819
FC
109 'experimental::const_attr' =>
110 [ 5.021, DEFAULT_ON ],
ea5519d6
AB
111 }],
112
113 'missing' => [ 5.021, DEFAULT_OFF],
114 'redundant' => [ 5.021, DEFAULT_OFF],
115 'locale' => [ 5.021, DEFAULT_ON],
116
117 #'default' => [ 5.008, DEFAULT_ON ],
118 }],
119
120 # When adding new warnings outside of "all" make sure to
121 # either patch util.c to ignore them under -w and -W, or to
122 # generalize the facility for adding them so that it knows
123 # about warnings outside of "all".
124 'extra' => [ 5.021, {
125 'void_unusual' => [ 5.021, DEFAULT_OFF],
126 }],
127}]};
599cee73 128
7fc874e8 129my @def ;
599cee73
PM
130my %list ;
131my %Value ;
0d658bf5
PM
132my %ValueToName ;
133my %NameToValue ;
599cee73 134
0d658bf5
PM
135my %v_list = () ;
136
137sub valueWalk
138{
139 my $tre = shift ;
140 my @list = () ;
141 my ($k, $v) ;
142
143 foreach $k (sort keys %$tre) {
144 $v = $tre->{$k};
145 die "duplicate key $k\n" if defined $list{$k} ;
146 die "Value associated with key '$k' is not an ARRAY reference"
147 if !ref $v || ref $v ne 'ARRAY' ;
148
149 my ($ver, $rest) = @{ $v } ;
150 push @{ $v_list{$ver} }, $k;
c4a853d1 151
0d658bf5
PM
152 if (ref $rest)
153 { valueWalk ($rest) }
154
155 }
156
157}
158
159sub orderValues
160{
161 my $index = 0;
162 foreach my $ver ( sort { $a <=> $b } keys %v_list ) {
163 foreach my $name (@{ $v_list{$ver} } ) {
164 $ValueToName{ $index } = [ uc $name, $ver ] ;
165 $NameToValue{ uc $name } = $index ++ ;
166 }
167 }
168
169 return $index ;
170}
171
172###########################################################################
173
599cee73
PM
174sub walk
175{
176 my $tre = shift ;
177 my @list = () ;
178 my ($k, $v) ;
179
95dfd3ab
GS
180 foreach $k (sort keys %$tre) {
181 $v = $tre->{$k};
599cee73 182 die "duplicate key $k\n" if defined $list{$k} ;
0d658bf5
PM
183 die "Can't find key '$k'"
184 if ! defined $NameToValue{uc $k} ;
185 push @{ $list{$k} }, $NameToValue{uc $k} ;
186 die "Value associated with key '$k' is not an ARRAY reference"
187 if !ref $v || ref $v ne 'ARRAY' ;
c4a853d1 188
0d658bf5
PM
189 my ($ver, $rest) = @{ $v } ;
190 if (ref $rest)
191 { push (@{ $list{$k} }, walk ($rest)) }
7fc874e8
FC
192 elsif ($rest == DEFAULT_ON)
193 { push @def, $NameToValue{uc $k} }
0d658bf5 194
599cee73
PM
195 push @list, @{ $list{$k} } ;
196 }
197
198 return @list ;
599cee73
PM
199}
200
201###########################################################################
202
203sub mkRange
204{
205 my @a = @_ ;
206 my @out = @a ;
599cee73 207
e95a9fc2 208 for my $i (1 .. @a - 1) {
0ca4541c 209 $out[$i] = ".."
e95a9fc2
KW
210 if $a[$i] == $a[$i - 1] + 1
211 && ($i >= @a - 1 || $a[$i] + 1 == $a[$i + 1] );
599cee73 212 }
e95a9fc2 213 $out[-1] = $a[-1] if $out[-1] eq "..";
599cee73
PM
214
215 my $out = join(",",@out);
216
217 $out =~ s/,(\.\.,)+/../g ;
218 return $out;
219}
220
221###########################################################################
e15f14b8 222sub warningsTree
e476b1b5
GS
223{
224 my $tre = shift ;
225 my $prefix = shift ;
e476b1b5
GS
226 my ($k, $v) ;
227
228 my $max = (sort {$a <=> $b} map { length $_ } keys %$tre)[-1] ;
0d658bf5 229 my @keys = sort keys %$tre ;
e476b1b5 230
e15f14b8
RS
231 my $rv = '';
232
0d658bf5 233 while ($k = shift @keys) {
e476b1b5 234 $v = $tre->{$k};
0d658bf5
PM
235 die "Value associated with key '$k' is not an ARRAY reference"
236 if !ref $v || ref $v ne 'ARRAY' ;
c4a853d1 237
0d658bf5
PM
238 my $offset ;
239 if ($tre ne $tree) {
e15f14b8
RS
240 $rv .= $prefix . "|\n" ;
241 $rv .= $prefix . "+- $k" ;
0d658bf5
PM
242 $offset = ' ' x ($max + 4) ;
243 }
244 else {
e15f14b8 245 $rv .= $prefix . "$k" ;
0d658bf5
PM
246 $offset = ' ' x ($max + 1) ;
247 }
248
249 my ($ver, $rest) = @{ $v } ;
f1d34ca8 250 if (ref $rest)
0ca4541c 251 {
0d658bf5 252 my $bar = @keys ? "|" : " ";
e15f14b8
RS
253 $rv .= " -" . "-" x ($max - length $k ) . "+\n" ;
254 $rv .= warningsTree ($rest, $prefix . $bar . $offset )
e476b1b5
GS
255 }
256 else
e15f14b8 257 { $rv .= "\n" }
e476b1b5
GS
258 }
259
e15f14b8 260 return $rv;
e476b1b5
GS
261}
262
263###########################################################################
599cee73 264
317ea90d 265sub mkHexOct
599cee73 266{
317ea90d 267 my ($f, $max, @a) = @_ ;
599cee73
PM
268 my $mask = "\x00" x $max ;
269 my $string = "" ;
270
271 foreach (@a) {
272 vec($mask, $_, 1) = 1 ;
273 }
274
599cee73 275 foreach (unpack("C*", $mask)) {
317ea90d
MS
276 if ($f eq 'x') {
277 $string .= '\x' . sprintf("%2.2x", $_)
278 }
279 else {
280 $string .= '\\' . sprintf("%o", $_)
281 }
599cee73
PM
282 }
283 return $string ;
284}
285
317ea90d
MS
286sub mkHex
287{
288 my($max, @a) = @_;
289 return mkHexOct("x", $max, @a);
290}
291
292sub mkOct
293{
294 my($max, @a) = @_;
295 return mkHexOct("o", $max, @a);
296}
297
599cee73
PM
298###########################################################################
299
e476b1b5
GS
300if (@ARGV && $ARGV[0] eq "tree")
301{
2f3cbe10 302 print warningsTree($tree, " ") ;
e476b1b5
GS
303 exit ;
304}
599cee73 305
cc49830d
NC
306my ($warn, $pm) = map {
307 open_new($_, '>', { by => 'regen/warnings.pl' });
308} 'warnings.h', 'lib/warnings.pm';
599cee73 309
c4a853d1
RS
310my ($index, $warn_size);
311
312{
313 # generate warnings.h
314
315 print $warn <<'EOM';
599cee73 316
0453d815
PM
317#define Off(x) ((x) / 8)
318#define Bit(x) (1 << ((x) % 8))
599cee73
PM
319#define IsSet(a, x) ((a)[Off(x)] & Bit(x))
320
0453d815 321
599cee73 322#define G_WARN_OFF 0 /* $^W == 0 */
0453d815 323#define G_WARN_ON 1 /* -w flag and $^W != 0 */
599cee73
PM
324#define G_WARN_ALL_ON 2 /* -W flag */
325#define G_WARN_ALL_OFF 4 /* -X flag */
0453d815 326#define G_WARN_ONCE 8 /* set if 'once' ever enabled */
599cee73
PM
327#define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF)
328
a0714e2c 329#define pWARN_STD NULL
72dc9ed5
NC
330#define pWARN_ALL (((STRLEN*)0)+1) /* use warnings 'all' */
331#define pWARN_NONE (((STRLEN*)0)+2) /* no warnings 'all' */
599cee73 332
d3a7d8c7
GS
333#define specialWARN(x) ((x) == pWARN_STD || (x) == pWARN_ALL || \
334 (x) == pWARN_NONE)
5f2d9966
DM
335
336/* if PL_warnhook is set to this value, then warnings die */
06dcd5bf 337#define PERL_WARNHOOK_FATAL (&PL_sv_placeholder)
599cee73
PM
338EOM
339
c4a853d1 340 my $offset = 0 ;
d3a7d8c7 341
c4a853d1
RS
342 valueWalk ($tree) ;
343 $index = orderValues();
599cee73 344
c4a853d1 345 die <<EOM if $index > 255 ;
12bcd1a6 346Too many warnings categories -- max is 255
c4a853d1 347 rewrite packWARN* & unpackWARN* macros
12bcd1a6 348EOM
599cee73 349
c4a853d1 350 walk ($tree) ;
0d658bf5 351
c4a853d1
RS
352 $index *= 2 ;
353 $warn_size = int($index / 8) + ($index % 8 != 0) ;
599cee73 354
c4a853d1
RS
355 my $k ;
356 my $last_ver = 0;
357 foreach $k (sort { $a <=> $b } keys %ValueToName) {
358 my ($name, $version) = @{ $ValueToName{$k} };
359 print $warn "\n/* Warnings Categories added in Perl $version */\n\n"
360 if $last_ver != $version ;
361 $name =~ y/:/_/;
362 print $warn tab(5, "#define WARN_$name"), " $k\n" ;
363 $last_ver = $version ;
364 }
365 print $warn "\n" ;
599cee73 366
c4a853d1
RS
367 print $warn tab(5, '#define WARNsize'), "$warn_size\n" ;
368 print $warn tab(5, '#define WARN_ALLstring'), '"', ('\125' x $warn_size) , "\"\n" ;
369 print $warn tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) , "\"\n" ;
599cee73 370
c4a853d1 371 print $warn <<'EOM';
599cee73 372
d5a71f30
GS
373#define isLEXWARN_on (PL_curcop->cop_warnings != pWARN_STD)
374#define isLEXWARN_off (PL_curcop->cop_warnings == pWARN_STD)
375#define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
72dc9ed5
NC
376#define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)))
377#define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1))
378
379#define DUP_WARNINGS(p) \
594cd643
NC
380 (specialWARN(p) ? (STRLEN*)(p) \
381 : (STRLEN*)CopyD(p, PerlMemShared_malloc(sizeof(*p)+*p), sizeof(*p)+*p, \
382 char))
d5a71f30 383
f54ba1c2 384#define ckWARN(w) Perl_ckwarn(aTHX_ packWARN(w))
7c08c4c5
KW
385
386/* The w1, w2 ... should be independent warnings categories; one shouldn't be
387 * a subcategory of any other */
388
f54ba1c2
DM
389#define ckWARN2(w1,w2) Perl_ckwarn(aTHX_ packWARN2(w1,w2))
390#define ckWARN3(w1,w2,w3) Perl_ckwarn(aTHX_ packWARN3(w1,w2,w3))
391#define ckWARN4(w1,w2,w3,w4) Perl_ckwarn(aTHX_ packWARN4(w1,w2,w3,w4))
392
393#define ckWARN_d(w) Perl_ckwarn_d(aTHX_ packWARN(w))
394#define ckWARN2_d(w1,w2) Perl_ckwarn_d(aTHX_ packWARN2(w1,w2))
395#define ckWARN3_d(w1,w2,w3) Perl_ckwarn_d(aTHX_ packWARN3(w1,w2,w3))
396#define ckWARN4_d(w1,w2,w3,w4) Perl_ckwarn_d(aTHX_ packWARN4(w1,w2,w3,w4))
12bcd1a6 397
98fe6610
NC
398#define WARNshift 8
399
3b9e3074 400#define packWARN(a) (a )
7c08c4c5
KW
401
402/* The a, b, ... should be independent warnings categories; one shouldn't be
403 * a subcategory of any other */
404
3b9e3074
SH
405#define packWARN2(a,b) ((a) | ((b)<<8) )
406#define packWARN3(a,b,c) ((a) | ((b)<<8) | ((c)<<16) )
407#define packWARN4(a,b,c,d) ((a) | ((b)<<8) | ((c)<<16) | ((d) <<24))
12bcd1a6
PM
408
409#define unpackWARN1(x) ((x) & 0xFF)
410#define unpackWARN2(x) (((x) >>8) & 0xFF)
411#define unpackWARN3(x) (((x) >>16) & 0xFF)
412#define unpackWARN4(x) (((x) >>24) & 0xFF)
413
414#define ckDEAD(x) \
415 ( ! specialWARN(PL_curcop->cop_warnings) && \
416 ( isWARNf_on(PL_curcop->cop_warnings, WARN_ALL) || \
417 isWARNf_on(PL_curcop->cop_warnings, unpackWARN1(x)) || \
418 isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) || \
419 isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) || \
420 isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x))))
421
4438c4b7 422/* end of file warnings.h */
599cee73
PM
423EOM
424
c4a853d1
RS
425 read_only_bottom_close_and_rename($warn);
426}
599cee73
PM
427
428while (<DATA>) {
429 last if /^KEYWORDS$/ ;
424a4936 430 print $pm $_ ;
599cee73
PM
431}
432
c4a853d1 433my $last_ver = 0;
424a4936 434print $pm "our %Offsets = (\n" ;
0d658bf5
PM
435foreach my $k (sort { $a <=> $b } keys %ValueToName) {
436 my ($name, $version) = @{ $ValueToName{$k} };
437 $name = lc $name;
d3a7d8c7 438 $k *= 2 ;
0d658bf5 439 if ( $last_ver != $version ) {
424a4936
NC
440 print $pm "\n";
441 print $pm tab(4, " # Warnings Categories added in Perl $version");
442 print $pm "\n\n";
0d658bf5 443 }
424a4936 444 print $pm tab(4, " '$name'"), "=> $k,\n" ;
0d658bf5 445 $last_ver = $version;
d3a7d8c7
GS
446}
447
424a4936 448print $pm " );\n\n" ;
d3a7d8c7 449
424a4936 450print $pm "our %Bits = (\n" ;
c4a853d1 451foreach my $k (sort keys %list) {
599cee73
PM
452
453 my $v = $list{$k} ;
454 my @list = sort { $a <=> $b } @$v ;
455
424a4936 456 print $pm tab(4, " '$k'"), '=> "',
0ca4541c 457 mkHex($warn_size, map $_ * 2 , @list),
599cee73
PM
458 '", # [', mkRange(@list), "]\n" ;
459}
460
424a4936 461print $pm " );\n\n" ;
599cee73 462
424a4936 463print $pm "our %DeadBits = (\n" ;
c4a853d1 464foreach my $k (sort keys %list) {
599cee73
PM
465
466 my $v = $list{$k} ;
467 my @list = sort { $a <=> $b } @$v ;
468
424a4936 469 print $pm tab(4, " '$k'"), '=> "',
0ca4541c 470 mkHex($warn_size, map $_ * 2 + 1 , @list),
599cee73
PM
471 '", # [', mkRange(@list), "]\n" ;
472}
473
424a4936
NC
474print $pm " );\n\n" ;
475print $pm '$NONE = "', ('\0' x $warn_size) , "\";\n" ;
7fc874e8
FC
476print $pm '$DEFAULT = "', mkHex($warn_size, map $_ * 2, @def),
477 '", # [', mkRange(@def), "]\n" ;
424a4936
NC
478print $pm '$LAST_BIT = ' . "$index ;\n" ;
479print $pm '$BYTES = ' . "$warn_size ;\n" ;
599cee73 480while (<DATA>) {
effd17dc 481 if ($_ eq "=for warnings.pl tree-goes-here\n") {
2f3cbe10 482 print $pm warningsTree($tree, " ");
effd17dc
DD
483 next;
484 }
424a4936 485 print $pm $_ ;
599cee73
PM
486}
487
ce716c52 488read_only_bottom_close_and_rename($pm);
599cee73
PM
489
490__END__
4438c4b7 491package warnings;
599cee73 492
ea5519d6 493our $VERSION = '1.30';
f2c3e829
RGS
494
495# Verify that we're called correctly so that warnings will work.
496# see also strict.pm.
5108dc18 497unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) {
f2c3e829 498 my (undef, $f, $l) = caller;
5108dc18 499 die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n");
f2c3e829 500}
b75c8c73 501
effd17dc
DD
502KEYWORDS
503
504$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
505
506sub Croaker
507{
508 require Carp; # this initializes %CarpInternal
509 local $Carp::CarpInternal{'warnings'};
510 delete $Carp::CarpInternal{'warnings'};
511 Carp::croak(@_);
512}
513
514sub _bits {
515 my $mask = shift ;
516 my $catmask ;
517 my $fatal = 0 ;
518 my $no_fatal = 0 ;
519
520 foreach my $word ( @_ ) {
521 if ($word eq 'FATAL') {
522 $fatal = 1;
523 $no_fatal = 0;
524 }
525 elsif ($word eq 'NONFATAL') {
526 $fatal = 0;
527 $no_fatal = 1;
528 }
529 elsif ($catmask = $Bits{$word}) {
530 $mask |= $catmask ;
531 $mask |= $DeadBits{$word} if $fatal ;
532 $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
533 }
534 else
56873d42 535 { Croaker("Unknown warnings category '$word'")}
effd17dc
DD
536 }
537
538 return $mask ;
539}
540
541sub bits
542{
543 # called from B::Deparse.pm
544 push @_, 'all' unless @_ ;
545 return _bits(undef, @_) ;
546}
547
548sub import
549{
550 shift;
551
552 my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
553
554 if (vec($mask, $Offsets{'all'}, 1)) {
56873d42
DD
555 $mask |= $Bits{'all'} ;
556 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
effd17dc
DD
557 }
558
559 # append 'all' when implied (after a lone "FATAL" or "NONFATAL")
560 push @_, 'all' if @_==1 && ( $_[0] eq 'FATAL' || $_[0] eq 'NONFATAL' );
561
562 # Empty @_ is equivalent to @_ = 'all' ;
563 ${^WARNING_BITS} = @_ ? _bits($mask, @_) : $mask | $Bits{all} ;
564}
565
566sub unimport
567{
568 shift;
569
570 my $catmask ;
571 my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
572
573 if (vec($mask, $Offsets{'all'}, 1)) {
56873d42
DD
574 $mask |= $Bits{'all'} ;
575 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
effd17dc
DD
576 }
577
578 # append 'all' when implied (empty import list or after a lone "FATAL")
579 push @_, 'all' if !@_ || @_==1 && $_[0] eq 'FATAL';
580
581 foreach my $word ( @_ ) {
582 if ($word eq 'FATAL') {
583 next;
584 }
585 elsif ($catmask = $Bits{$word}) {
586 $mask &= ~($catmask | $DeadBits{$word} | $All);
587 }
588 else
56873d42 589 { Croaker("Unknown warnings category '$word'")}
effd17dc
DD
590 }
591
592 ${^WARNING_BITS} = $mask ;
593}
594
595my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
596
597sub MESSAGE () { 4 };
598sub FATAL () { 2 };
599sub NORMAL () { 1 };
600
601sub __chk
602{
603 my $category ;
604 my $offset ;
605 my $isobj = 0 ;
606 my $wanted = shift;
607 my $has_message = $wanted & MESSAGE;
608
609 unless (@_ == 1 || @_ == ($has_message ? 2 : 0)) {
610 my $sub = (caller 1)[3];
611 my $syntax = $has_message ? "[category,] 'message'" : '[category]';
612 Croaker("Usage: $sub($syntax)");
613 }
614
615 my $message = pop if $has_message;
616
617 if (@_) {
56873d42
DD
618 # check the category supplied.
619 $category = shift ;
620 if (my $type = ref $category) {
621 Croaker("not an object")
622 if exists $builtin_type{$type};
effd17dc 623 $category = $type;
56873d42
DD
624 $isobj = 1 ;
625 }
626 $offset = $Offsets{$category};
627 Croaker("Unknown warnings category '$category'")
effd17dc
DD
628 unless defined $offset;
629 }
630 else {
56873d42
DD
631 $category = (caller(1))[0] ;
632 $offset = $Offsets{$category};
633 Croaker("package '$category' not registered for warnings")
effd17dc
DD
634 unless defined $offset ;
635 }
636
637 my $i;
638
639 if ($isobj) {
56873d42
DD
640 my $pkg;
641 $i = 2;
642 while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
643 last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
644 }
effd17dc
DD
645 $i -= 2 ;
646 }
647 else {
56873d42 648 $i = _error_loc(); # see where Carp will allocate the error
effd17dc
DD
649 }
650
651 # Default to 0 if caller returns nothing. Default to $DEFAULT if it
652 # explicitly returns undef.
653 my(@callers_bitmask) = (caller($i))[9] ;
654 my $callers_bitmask =
655 @callers_bitmask ? $callers_bitmask[0] // $DEFAULT : 0 ;
656
657 my @results;
658 foreach my $type (FATAL, NORMAL) {
659 next unless $wanted & $type;
660
661 push @results, (vec($callers_bitmask, $offset + $type - 1, 1) ||
662 vec($callers_bitmask, $Offsets{'all'} + $type - 1, 1));
663 }
664
665 # &enabled and &fatal_enabled
666 return $results[0] unless $has_message;
667
668 # &warnif, and the category is neither enabled as warning nor as fatal
669 return if $wanted == (NORMAL | FATAL | MESSAGE)
670 && !($results[0] || $results[1]);
671
672 require Carp;
673 Carp::croak($message) if $results[0];
674 # will always get here for &warn. will only get here for &warnif if the
675 # category is enabled
676 Carp::carp($message);
677}
678
679sub _mkMask
680{
681 my ($bit) = @_;
682 my $mask = "";
683
684 vec($mask, $bit, 1) = 1;
685 return $mask;
686}
687
688sub register_categories
689{
690 my @names = @_;
691
692 for my $name (@names) {
693 if (! defined $Bits{$name}) {
694 $Bits{$name} = _mkMask($LAST_BIT);
695 vec($Bits{'all'}, $LAST_BIT, 1) = 1;
696 $Offsets{$name} = $LAST_BIT ++;
697 foreach my $k (keys %Bits) {
698 vec($Bits{$k}, $LAST_BIT, 1) = 0;
699 }
700 $DeadBits{$name} = _mkMask($LAST_BIT);
701 vec($DeadBits{'all'}, $LAST_BIT++, 1) = 1;
702 }
703 }
704}
705
706sub _error_loc {
707 require Carp;
708 goto &Carp::short_error_loc; # don't introduce another stack frame
709}
710
711sub enabled
712{
713 return __chk(NORMAL, @_);
714}
715
716sub fatal_enabled
717{
718 return __chk(FATAL, @_);
719}
720
721sub warn
722{
723 return __chk(FATAL | MESSAGE, @_);
724}
725
726sub warnif
727{
728 return __chk(NORMAL | FATAL | MESSAGE, @_);
729}
730
731# These are not part of any public interface, so we can delete them to save
732# space.
733delete @warnings::{qw(NORMAL FATAL MESSAGE)};
734
7351;
736__END__
599cee73
PM
737=head1 NAME
738
4438c4b7 739warnings - Perl pragma to control optional warnings
599cee73
PM
740
741=head1 SYNOPSIS
742
4438c4b7
JH
743 use warnings;
744 no warnings;
599cee73 745
4438c4b7
JH
746 use warnings "all";
747 no warnings "all";
599cee73 748
d3a7d8c7
GS
749 use warnings::register;
750 if (warnings::enabled()) {
751 warnings::warn("some warning");
752 }
753
754 if (warnings::enabled("void")) {
e476b1b5
GS
755 warnings::warn("void", "some warning");
756 }
757
7e6d00f8
PM
758 if (warnings::enabled($object)) {
759 warnings::warn($object, "some warning");
760 }
761
721f911b
PM
762 warnings::warnif("some warning");
763 warnings::warnif("void", "some warning");
764 warnings::warnif($object, "some warning");
7e6d00f8 765
599cee73
PM
766=head1 DESCRIPTION
767
188c4f6f
RS
768The C<warnings> pragma gives control over which warnings are enabled in
769which parts of a Perl program. It's a more flexible alternative for
770both the command line flag B<-w> and the equivalent Perl variable,
771C<$^W>.
33edcb80
RS
772
773This pragma works just like the C<strict> pragma.
774This means that the scope of the warning pragma is limited to the
775enclosing block. It also means that the pragma setting will not
776leak across files (via C<use>, C<require> or C<do>). This allows
777authors to independently define the degree of warning checks that will
778be applied to their module.
779
780By default, optional warnings are disabled, so any legacy code that
781doesn't attempt to control the warnings will work unchanged.
782
ea5519d6
AB
783When we talk about "all" warnings we don't actually mean "all the
784warnings we support". See L</Top-level warning categories & associated
785confusion> for details. The "all" category should really be called the
786"default" category, if not for backwards-compatibility concerns.
787
788"All" warnings are enabled in a block by either of these:
33edcb80
RS
789
790 use warnings;
791 use warnings 'all';
792
ea5519d6 793Similarly "all" warnings are disabled in a block by either of these:
33edcb80
RS
794
795 no warnings;
796 no warnings 'all';
797
798For example, consider the code below:
799
800 use warnings;
801 my @a;
802 {
803 no warnings;
804 my $b = @a[0];
805 }
806 my $c = @a[0];
807
808The code in the enclosing block has warnings enabled, but the inner
809block has them disabled. In this case that means the assignment to the
810scalar C<$c> will trip the C<"Scalar value @a[0] better written as $a[0]">
811warning, but the assignment to the scalar C<$b> will not.
812
813=head2 Default Warnings and Optional Warnings
814
815Before the introduction of lexical warnings, Perl had two classes of
56873d42 816warnings: mandatory and optional.
33edcb80
RS
817
818As its name suggests, if your code tripped a mandatory warning, you
819would get a warning whether you wanted it or not.
820For example, the code below would always produce an C<"isn't numeric">
821warning about the "2:".
822
823 my $a = "2:" + 3;
824
825With the introduction of lexical warnings, mandatory warnings now become
826I<default> warnings. The difference is that although the previously
827mandatory warnings are still enabled by default, they can then be
828subsequently enabled or disabled with the lexical warning pragma. For
829example, in the code below, an C<"isn't numeric"> warning will only
830be reported for the C<$a> variable.
831
832 my $a = "2:" + 3;
833 no warnings;
834 my $b = "2:" + 3;
835
836Note that neither the B<-w> flag or the C<$^W> can be used to
837disable/enable default warnings. They are still mandatory in this case.
838
839=head2 What's wrong with B<-w> and C<$^W>
840
841Although very useful, the big problem with using B<-w> on the command
842line to enable warnings is that it is all or nothing. Take the typical
843scenario when you are writing a Perl program. Parts of the code you
844will write yourself, but it's very likely that you will make use of
845pre-written Perl modules. If you use the B<-w> flag in this case, you
846end up enabling warnings in pieces of code that you haven't written.
847
848Similarly, using C<$^W> to either disable or enable blocks of code is
849fundamentally flawed. For a start, say you want to disable warnings in
850a block of code. You might expect this to be enough to do the trick:
851
852 {
853 local ($^W) = 0;
854 my $a =+ 2;
855 my $b; chop $b;
856 }
857
858When this code is run with the B<-w> flag, a warning will be produced
859for the C<$a> line: C<"Reversed += operator">.
860
861The problem is that Perl has both compile-time and run-time warnings. To
862disable compile-time warnings you need to rewrite the code like this:
863
864 {
865 BEGIN { $^W = 0 }
866 my $a =+ 2;
867 my $b; chop $b;
868 }
869
870The other big problem with C<$^W> is the way you can inadvertently
871change the warning setting in unexpected places in your code. For example,
872when the code below is run (without the B<-w> flag), the second call
873to C<doit> will trip a C<"Use of uninitialized value"> warning, whereas
874the first will not.
875
876 sub doit
877 {
878 my $b; chop $b;
879 }
880
881 doit();
882
883 {
884 local ($^W) = 1;
885 doit()
886 }
887
888This is a side-effect of C<$^W> being dynamically scoped.
889
890Lexical warnings get around these limitations by allowing finer control
891over where warnings can or can't be tripped.
892
893=head2 Controlling Warnings from the Command Line
894
895There are three Command Line flags that can be used to control when
896warnings are (or aren't) produced:
897
898=over 5
899
900=item B<-w>
901X<-w>
902
903This is the existing flag. If the lexical warnings pragma is B<not>
904used in any of you code, or any of the modules that you use, this flag
905will enable warnings everywhere. See L<Backward Compatibility> for
906details of how this flag interacts with lexical warnings.
907
908=item B<-W>
909X<-W>
910
ea5519d6 911If the B<-W> flag is used on the command line, it will enable "all" warnings
33edcb80
RS
912throughout the program regardless of whether warnings were disabled
913locally using C<no warnings> or C<$^W =0>.
914This includes all files that get
915included via C<use>, C<require> or C<do>.
916Think of it as the Perl equivalent of the "lint" command.
917
918=item B<-X>
919X<-X>
920
ea5519d6 921Does the exact opposite to the B<-W> flag, i.e. it disables "all" warnings.
33edcb80
RS
922
923=back
924
ea5519d6
AB
925=head2 Top-level warning categories & associated confusion
926
927The lexical warning pragma was introduced in v5.6.0 of perl, and from
928the very beginning doing C<use warnings> would enable the "all"
929category of warnings, which were all the warnings we support.
930
931This led to arguments whenever someone suggested a new warning be
932added to perl, since that implicitly meant that existing programs that
933used the warnings pragma would be retroactively subjected to them when
934perl was upgraded.
935
936So similarly to how most C compilers support C<-Wall> to mean "not
937quite all warnings" along with extra options like C<-Wextra>, we
938support warnings outside of the "all" category. Think of the "all"
939category as "default", that's what we'd call it we were starting out
940today and didn't have a bunch of programs doing C<use warnings "all">
941in the wild already.
942
943The categories we support are:
944
945=over
946
947=item * all
948
949This is the "default" category for warnings that we've supported ever
950since v5.6.0. We have and might occasionally add new warnings here if
951they're deemed to be similar in nature to our existing warnings, but
952mostly these are things we're pretty sure are a logic error, but
953aren't irrecoverable, so they're not a runtime error.
954
955When you upgrade perl you might find that we've added some new
956warnings here, but they won't be anything wildly different from the
957current set of warnings, so the burden of going through your existing
958code and auditing the new parts that are warning should be fairly
959light.
960
961=item * everything
962
963This is what "all" would be if the world made any sense, but since we
964started out with "all" you need to enable "everything" to really
965enable "all the warnings".
966
967You almost definitely don't want to enable "everything", unless you're
968willing to potentially get a flood of new warnings with every perl
969upgrade, and those warnings may be entirely different in spirit to
970existing warnings shipped with previous releases.
971
972Maybe we'll start introducing really pedantic warnings that aren't
973useful for most cases, maybe we'll start warning about inconsistent
974indentation, who knows? If you really want ALL the warnings perl has
975to offer enable these, otherwise stick with some more sane category.
976
977=item * extra
978
979These are warnings that we might have put into "all"
980(a.k.a. "default") if we had a time machine and were starting out with
981perl today, but they'd probably cause too much of a disruption today
982so we're not doing that.
983
984As of writing this the sole warning in this category is a warning
985about useless use of grep in void context, but unlike for the "all"
986category we reserve the right to freely add things to this category in
987the future.
988
989=back
990
991In the future we might add any number of other top-level
992categories. The backwards-compatibility promises of those categories
993(if any) will be documented here.
994
33edcb80
RS
995=head2 Backward Compatibility
996
997If you are used to working with a version of Perl prior to the
998introduction of lexically scoped warnings, or have code that uses both
999lexical warnings and C<$^W>, this section will describe how they interact.
1000
1001How Lexical Warnings interact with B<-w>/C<$^W>:
1002
1003=over 5
1004
1005=item 1.
1006
1007If none of the three command line flags (B<-w>, B<-W> or B<-X>) that
1008control warnings is used and neither C<$^W> nor the C<warnings> pragma
1009are used, then default warnings will be enabled and optional warnings
1010disabled.
1011This means that legacy code that doesn't attempt to control the warnings
1012will work unchanged.
1013
1014=item 2.
1015
1016The B<-w> flag just sets the global C<$^W> variable as in 5.005. This
1017means that any legacy code that currently relies on manipulating C<$^W>
56873d42 1018to control warning behavior will still work as is.
33edcb80
RS
1019
1020=item 3.
1021
1022Apart from now being a boolean, the C<$^W> variable operates in exactly
1023the same horrible uncontrolled global way, except that it cannot
1024disable/enable default warnings.
1025
1026=item 4.
1027
1028If a piece of code is under the control of the C<warnings> pragma,
1029both the C<$^W> variable and the B<-w> flag will be ignored for the
1030scope of the lexical warning.
1031
1032=item 5.
1033
1034The only way to override a lexical warnings setting is with the B<-W>
1035or B<-X> command line flags.
1036
1037=back
1038
1039The combined effect of 3 & 4 is that it will allow code which uses
1040the C<warnings> pragma to control the warning behavior of $^W-type
1041code (using a C<local $^W=0>) if it really wants to, but not vice-versa.
1042
1043=head2 Category Hierarchy
1044X<warning, categories>
1045
1046A hierarchy of "categories" have been defined to allow groups of warnings
1047to be enabled/disabled in isolation.
1048
1049The current hierarchy is:
1050
1051=for warnings.pl tree-goes-here
1052
1053Just like the "strict" pragma any of these categories can be combined
1054
1055 use warnings qw(void redefine);
1056 no warnings qw(io syntax untie);
1057
1058Also like the "strict" pragma, if there is more than one instance of the
56873d42 1059C<warnings> pragma in a given scope the cumulative effect is additive.
33edcb80
RS
1060
1061 use warnings qw(void); # only "void" warnings enabled
1062 ...
1063 use warnings qw(io); # only "void" & "io" warnings enabled
1064 ...
1065 no warnings qw(void); # only "io" warnings enabled
1066
1067To determine which category a specific warning has been assigned to see
1068L<perldiag>.
1069
1070Note: Before Perl 5.8.0, the lexical warnings category "deprecated" was a
1071sub-category of the "syntax" category. It is now a top-level category
1072in its own right.
1073
3664866e
AB
1074Note: Before 5.21.0, the "missing" lexical warnings category was
1075internally defined to be the same as the "uninitialized" category. It
1076is now a top-level category in its own right.
1077
33edcb80
RS
1078=head2 Fatal Warnings
1079X<warning, fatal>
1080
1081The presence of the word "FATAL" in the category list will escalate any
1082warnings detected from the categories specified in the lexical scope
1083into fatal errors. In the code below, the use of C<time>, C<length>
1084and C<join> can all produce a C<"Useless use of xxx in void context">
1085warning.
1086
1087 use warnings;
1088
1089 time;
1090
1091 {
1092 use warnings FATAL => qw(void);
1093 length "abc";
1094 }
1095
1096 join "", 1,2,3;
1097
1098 print "done\n";
1099
1100When run it produces this output
1101
1102 Useless use of time in void context at fatal line 3.
56873d42 1103 Useless use of length in void context at fatal line 7.
33edcb80
RS
1104
1105The scope where C<length> is used has escalated the C<void> warnings
1106category into a fatal error, so the program terminates immediately when it
1107encounters the warning.
1108
1109To explicitly turn off a "FATAL" warning you just disable the warning
1110it is associated with. So, for example, to disable the "void" warning
1111in the example above, either of these will do the trick:
1112
1113 no warnings qw(void);
1114 no warnings FATAL => qw(void);
1115
1116If you want to downgrade a warning that has been escalated into a fatal
1117error back to a normal warning, you can use the "NONFATAL" keyword. For
1118example, the code below will promote all warnings into fatal errors,
1119except for those in the "syntax" category.
1120
1121 use warnings FATAL => 'all', NONFATAL => 'syntax';
1122
1123As of Perl 5.20, instead of C<< use warnings FATAL => 'all'; >> you can
1124use:
1125
1126 use v5.20; # Perl 5.20 or greater is required for the following
1127 use warnings 'FATAL'; # short form of "use warnings FATAL => 'all';"
1128
1129If you want your program to be compatible with versions of Perl before
11305.20, you must use C<< use warnings FATAL => 'all'; >> instead. (In
1131previous versions of Perl, the behavior of the statements
1132C<< use warnings 'FATAL'; >>, C<< use warnings 'NONFATAL'; >> and
1133C<< no warnings 'FATAL'; >> was unspecified; they did not behave as if
1134they included the C<< => 'all' >> portion. As of 5.20, they do.)
1135
1136B<NOTE:> Users of FATAL warnings, especially
1137those using C<< FATAL => 'all' >>
1138should be fully aware that they are risking future portability of their
1139programs by doing so. Perl makes absolutely no commitments to not
1140introduce new warnings, or warnings categories in the future, and indeed
1141we explicitly reserve the right to do so. Code that may not warn now may
1142warn in a future release of Perl if the Perl5 development team deems it
1143in the best interests of the community to do so. Should code using FATAL
1144warnings break due to the introduction of a new warning we will NOT
1145consider it an incompatible change. Users of FATAL warnings should take
1146special caution during upgrades to check to see if their code triggers
1147any new warnings and should pay particular attention to the fine print of
1148the documentation of the features they use to ensure they do not exploit
1149features that are documented as risky, deprecated, or unspecified, or where
1150the documentation says "so don't do that", or anything with the same sense
1151and spirit. Use of such features in combination with FATAL warnings is
1152ENTIRELY AT THE USER'S RISK.
1153
1154=head2 Reporting Warnings from a Module
1155X<warning, reporting> X<warning, registering>
1156
1157The C<warnings> pragma provides a number of functions that are useful for
1158module authors. These are used when you want to report a module-specific
1159warning to a calling module has enabled warnings via the C<warnings>
1160pragma.
1161
1162Consider the module C<MyMod::Abc> below.
1163
1164 package MyMod::Abc;
1165
1166 use warnings::register;
1167
1168 sub open {
1169 my $path = shift;
1170 if ($path !~ m#^/#) {
1171 warnings::warn("changing relative path to /var/abc")
1172 if warnings::enabled();
1173 $path = "/var/abc/$path";
1174 }
1175 }
1176
1177 1;
1178
1179The call to C<warnings::register> will create a new warnings category
1180called "MyMod::Abc", i.e. the new category name matches the current
1181package name. The C<open> function in the module will display a warning
1182message if it gets given a relative path as a parameter. This warnings
1183will only be displayed if the code that uses C<MyMod::Abc> has actually
1184enabled them with the C<warnings> pragma like below.
1185
1186 use MyMod::Abc;
1187 use warnings 'MyMod::Abc';
1188 ...
1189 abc::open("../fred.txt");
1190
1191It is also possible to test whether the pre-defined warnings categories are
1192set in the calling module with the C<warnings::enabled> function. Consider
1193this snippet of code:
1194
1195 package MyMod::Abc;
1196
1197 sub open {
56873d42 1198 warnings::warnif("deprecated",
33edcb80
RS
1199 "open is deprecated, use new instead");
1200 new(@_);
1201 }
1202
1203 sub new
1204 ...
1205 1;
1206
1207The function C<open> has been deprecated, so code has been included to
1208display a warning message whenever the calling module has (at least) the
1209"deprecated" warnings category enabled. Something like this, say.
1210
1211 use warnings 'deprecated';
1212 use MyMod::Abc;
1213 ...
1214 MyMod::Abc::open($filename);
1215
1216Either the C<warnings::warn> or C<warnings::warnif> function should be
1217used to actually display the warnings message. This is because they can
1218make use of the feature that allows warnings to be escalated into fatal
1219errors. So in this case
1220
1221 use MyMod::Abc;
1222 use warnings FATAL => 'MyMod::Abc';
1223 ...
1224 MyMod::Abc::open('../fred.txt');
1225
1226the C<warnings::warnif> function will detect this and die after
1227displaying the warning message.
1228
1229The three warnings functions, C<warnings::warn>, C<warnings::warnif>
1230and C<warnings::enabled> can optionally take an object reference in place
1231of a category name. In this case the functions will use the class name
1232of the object as the warnings category.
1233
1234Consider this example:
1235
1236 package Original;
1237
1238 no warnings;
1239 use warnings::register;
1240
1241 sub new
1242 {
1243 my $class = shift;
1244 bless [], $class;
1245 }
1246
1247 sub check
1248 {
1249 my $self = shift;
1250 my $value = shift;
1251
1252 if ($value % 2 && warnings::enabled($self))
1253 { warnings::warn($self, "Odd numbers are unsafe") }
1254 }
1255
1256 sub doit
1257 {
1258 my $self = shift;
1259 my $value = shift;
1260 $self->check($value);
1261 # ...
1262 }
1263
1264 1;
1265
1266 package Derived;
1267
1268 use warnings::register;
1269 use Original;
1270 our @ISA = qw( Original );
1271 sub new
1272 {
1273 my $class = shift;
1274 bless [], $class;
1275 }
1276
1277
1278 1;
1279
56873d42 1280The code below makes use of both modules, but it only enables warnings from
33edcb80
RS
1281C<Derived>.
1282
1283 use Original;
1284 use Derived;
1285 use warnings 'Derived';
1286 my $a = Original->new();
1287 $a->doit(1);
1288 my $b = Derived->new();
1289 $a->doit(1);
1290
1291When this code is run only the C<Derived> object, C<$b>, will generate
56873d42 1292a warning.
33edcb80
RS
1293
1294 Odd numbers are unsafe at main.pl line 7
1295
1296Notice also that the warning is reported at the line where the object is first
1297used.
1298
1299When registering new categories of warning, you can supply more names to
1300warnings::register like this:
1301
1302 package MyModule;
1303 use warnings::register qw(format precision);
1304
1305 ...
fe2e802c 1306
33edcb80 1307 warnings::warnif('MyModule::format', '...');
599cee73 1308
33edcb80 1309=head1 FUNCTIONS
e476b1b5
GS
1310
1311=over 4
1312
d3a7d8c7
GS
1313=item use warnings::register
1314
7e6d00f8
PM
1315Creates a new warnings category with the same name as the package where
1316the call to the pragma is used.
1317
1318=item warnings::enabled()
1319
1320Use the warnings category with the same name as the current package.
1321
1322Return TRUE if that warnings category is enabled in the calling module.
1323Otherwise returns FALSE.
1324
1325=item warnings::enabled($category)
1326
1327Return TRUE if the warnings category, C<$category>, is enabled in the
1328calling module.
1329Otherwise returns FALSE.
1330
1331=item warnings::enabled($object)
1332
1333Use the name of the class for the object reference, C<$object>, as the
1334warnings category.
1335
1336Return TRUE if that warnings category is enabled in the first scope
1337where the object is used.
1338Otherwise returns FALSE.
1339
ec983580
AR
1340=item warnings::fatal_enabled()
1341
1342Return TRUE if the warnings category with the same name as the current
1343package has been set to FATAL in the calling module.
1344Otherwise returns FALSE.
1345
1346=item warnings::fatal_enabled($category)
1347
1348Return TRUE if the warnings category C<$category> has been set to FATAL in
1349the calling module.
1350Otherwise returns FALSE.
1351
1352=item warnings::fatal_enabled($object)
1353
1354Use the name of the class for the object reference, C<$object>, as the
1355warnings category.
1356
1357Return TRUE if that warnings category has been set to FATAL in the first
1358scope where the object is used.
1359Otherwise returns FALSE.
1360
7e6d00f8
PM
1361=item warnings::warn($message)
1362
1363Print C<$message> to STDERR.
1364
1365Use the warnings category with the same name as the current package.
1366
1367If that warnings category has been set to "FATAL" in the calling module
1368then die. Otherwise return.
1369
1370=item warnings::warn($category, $message)
1371
1372Print C<$message> to STDERR.
1373
1374If the warnings category, C<$category>, has been set to "FATAL" in the
1375calling module then die. Otherwise return.
d3a7d8c7 1376
7e6d00f8 1377=item warnings::warn($object, $message)
e476b1b5 1378
7e6d00f8 1379Print C<$message> to STDERR.
e476b1b5 1380
7e6d00f8
PM
1381Use the name of the class for the object reference, C<$object>, as the
1382warnings category.
e476b1b5 1383
7e6d00f8
PM
1384If that warnings category has been set to "FATAL" in the scope where C<$object>
1385is first used then die. Otherwise return.
599cee73 1386
e476b1b5 1387
7e6d00f8
PM
1388=item warnings::warnif($message)
1389
1390Equivalent to:
1391
1392 if (warnings::enabled())
1393 { warnings::warn($message) }
1394
1395=item warnings::warnif($category, $message)
1396
1397Equivalent to:
1398
1399 if (warnings::enabled($category))
1400 { warnings::warn($category, $message) }
1401
1402=item warnings::warnif($object, $message)
1403
1404Equivalent to:
1405
1406 if (warnings::enabled($object))
1407 { warnings::warn($object, $message) }
d3a7d8c7 1408
5e7ad92a 1409=item warnings::register_categories(@names)
13781810
FR
1410
1411This registers warning categories for the given names and is primarily for
d2ec25a5 1412use by the warnings::register pragma.
13781810 1413
e476b1b5
GS
1414=back
1415
d2ec25a5 1416See also L<perlmodlib/Pragmatic Modules> and L<perldiag>.
599cee73
PM
1417
1418=cut