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