3 # Regenerate (overwriting only if changed):
8 # from information hardcoded into this script (the $tree hash), plus the
9 # template for warnings.pm in the DATA section.
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
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.
17 # This script is normally invoked from regen.pl.
22 require './regen/regen_lib.pl';
27 sub DEFAULT_ON () { 1 }
28 sub DEFAULT_OFF () { 2 }
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],
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],
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],
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],
78 'surrogate' => [ 5.013, DEFAULT_OFF],
79 'nonchar' => [ 5.013, DEFAULT_OFF],
80 'non_unicode' => [ 5.013, DEFAULT_OFF],
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::smartmatch' =>
93 [ 5.017, DEFAULT_ON ],
94 'experimental::postderef' =>
95 [ 5.019, DEFAULT_ON ],
96 'experimental::signatures' =>
97 [ 5.019, DEFAULT_ON ],
98 'experimental::win32_perlio' =>
99 [ 5.021, DEFAULT_ON ],
100 'experimental::refaliasing' =>
101 [ 5.021, DEFAULT_ON ],
102 'experimental::re_strict' =>
103 [ 5.021, DEFAULT_ON ],
104 'experimental::const_attr' =>
105 [ 5.021, DEFAULT_ON ],
106 'experimental::bitwise' =>
107 [ 5.021, DEFAULT_ON ],
108 'experimental::declared_refs' =>
109 [ 5.025, DEFAULT_ON ],
112 'missing' => [ 5.021, DEFAULT_OFF],
113 'redundant' => [ 5.021, DEFAULT_OFF],
114 'locale' => [ 5.021, DEFAULT_ON],
116 #'default' => [ 5.008, DEFAULT_ON ],
133 foreach $k (sort keys %$tre) {
135 die "duplicate key $k\n" if defined $list{$k} ;
136 die "Value associated with key '$k' is not an ARRAY reference"
137 if !ref $v || ref $v ne 'ARRAY' ;
139 my ($ver, $rest) = @{ $v } ;
140 push @{ $v_list{$ver} }, $k;
143 { valueWalk ($rest) }
152 foreach my $ver ( sort { $a <=> $b } keys %v_list ) {
153 foreach my $name (@{ $v_list{$ver} } ) {
154 $ValueToName{ $index } = [ uc $name, $ver ] ;
155 $NameToValue{ uc $name } = $index ++ ;
162 ###########################################################################
170 foreach $k (sort keys %$tre) {
172 die "duplicate key $k\n" if defined $list{$k} ;
173 die "Can't find key '$k'"
174 if ! defined $NameToValue{uc $k} ;
175 push @{ $list{$k} }, $NameToValue{uc $k} ;
176 die "Value associated with key '$k' is not an ARRAY reference"
177 if !ref $v || ref $v ne 'ARRAY' ;
179 my ($ver, $rest) = @{ $v } ;
181 { push (@{ $list{$k} }, walk ($rest)) }
182 elsif ($rest == DEFAULT_ON)
183 { push @def, $NameToValue{uc $k} }
185 push @list, @{ $list{$k} } ;
191 ###########################################################################
198 for my $i (1 .. @a - 1) {
200 if $a[$i] == $a[$i - 1] + 1
201 && ($i >= @a - 1 || $a[$i] + 1 == $a[$i + 1] );
203 $out[-1] = $a[-1] if $out[-1] eq "..";
205 my $out = join(",",@out);
207 $out =~ s/,(\.\.,)+/../g ;
211 ###########################################################################
218 my $max = (sort {$a <=> $b} map { length $_ } keys %$tre)[-1] ;
219 my @keys = sort keys %$tre ;
223 while ($k = shift @keys) {
225 die "Value associated with key '$k' is not an ARRAY reference"
226 if !ref $v || ref $v ne 'ARRAY' ;
230 $rv .= $prefix . "|\n" ;
231 $rv .= $prefix . "+- $k" ;
232 $offset = ' ' x ($max + 4) ;
235 $rv .= $prefix . "$k" ;
236 $offset = ' ' x ($max + 1) ;
239 my ($ver, $rest) = @{ $v } ;
242 my $bar = @keys ? "|" : " ";
243 $rv .= " -" . "-" x ($max - length $k ) . "+\n" ;
244 $rv .= warningsTree ($rest, $prefix . $bar . $offset )
253 ###########################################################################
257 my ($f, $max, @a) = @_ ;
258 my $mask = "\x00" x $max ;
262 vec($mask, $_, 1) = 1 ;
265 foreach (unpack("C*", $mask)) {
267 $string .= '\x' . sprintf("%2.2x", $_)
270 $string .= '\\' . sprintf("%o", $_)
279 return mkHexOct("x", $max, @a);
285 return mkHexOct("o", $max, @a);
288 ###########################################################################
290 if (@ARGV && $ARGV[0] eq "tree")
292 print warningsTree($tree, " ") ;
296 my ($warn, $pm) = map {
297 open_new($_, '>', { by => 'regen/warnings.pl' });
298 } 'warnings.h', 'lib/warnings.pm';
300 my ($index, $warn_size);
303 # generate warnings.h
307 #define Off(x) ((x) / 8)
308 #define Bit(x) (1 << ((x) % 8))
309 #define IsSet(a, x) ((a)[Off(x)] & Bit(x))
312 #define G_WARN_OFF 0 /* $^W == 0 */
313 #define G_WARN_ON 1 /* -w flag and $^W != 0 */
314 #define G_WARN_ALL_ON 2 /* -W flag */
315 #define G_WARN_ALL_OFF 4 /* -X flag */
316 #define G_WARN_ONCE 8 /* set if 'once' ever enabled */
317 #define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF)
319 #define pWARN_STD NULL
320 #define pWARN_ALL (((STRLEN*)0)+1) /* use warnings 'all' */
321 #define pWARN_NONE (((STRLEN*)0)+2) /* no warnings 'all' */
323 #define specialWARN(x) ((x) == pWARN_STD || (x) == pWARN_ALL || \
326 /* if PL_warnhook is set to this value, then warnings die */
327 #define PERL_WARNHOOK_FATAL (&PL_sv_placeholder)
333 $index = orderValues();
335 die <<EOM if $index > 255 ;
336 Too many warnings categories -- max is 255
337 rewrite packWARN* & unpackWARN* macros
341 for (my $i = $index; $i & 3; $i++) {
342 push @{$list{all}}, $i;
346 $warn_size = int($index / 8) + ($index % 8 != 0) ;
350 foreach $k (sort { $a <=> $b } keys %ValueToName) {
351 my ($name, $version) = @{ $ValueToName{$k} };
352 print $warn "\n/* Warnings Categories added in Perl $version */\n\n"
353 if $last_ver != $version ;
355 print $warn tab(6, "#define WARN_$name"), " $k\n" ;
356 $last_ver = $version ;
360 print $warn tab(6, '#define WARNsize'), " $warn_size\n" ;
361 print $warn tab(6, '#define WARN_ALLstring'), ' "', ('\125' x $warn_size) , "\"\n" ;
362 print $warn tab(6, '#define WARN_NONEstring'), ' "', ('\0' x $warn_size) , "\"\n" ;
366 #define isLEXWARN_on \
367 cBOOL(PL_curcop && PL_curcop->cop_warnings != pWARN_STD)
368 #define isLEXWARN_off \
369 cBOOL(!PL_curcop || PL_curcop->cop_warnings == pWARN_STD)
370 #define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
371 #define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)))
372 #define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1))
374 #define DUP_WARNINGS(p) \
375 (specialWARN(p) ? (STRLEN*)(p) \
376 : (STRLEN*)CopyD(p, PerlMemShared_malloc(sizeof(*p)+*p), sizeof(*p)+*p, \
381 =head1 Warning and Dieing
383 =for apidoc Am|bool|ckWARN|U32 w
385 Returns a boolean as to whether or not warnings are enabled for the warning
386 category C<w>. If the category is by default enabled even if not within the
387 scope of S<C<use warnings>>, instead use the L</ckWARN_d> macro.
389 =for apidoc Am|bool|ckWARN_d|U32 w
391 Like C<L</ckWARN>>, but for use if and only if the warning category is by
392 default enabled even if not within the scope of S<C<use warnings>>.
394 =for apidoc Am|bool|ckWARN2|U32 w1|U32 w2
396 Like C<L</ckWARN>>, but takes two warnings categories as input, and returns
397 TRUE if either is enabled. If either category is by default enabled even if
398 not within the scope of S<C<use warnings>>, instead use the L</ckWARN2_d>
399 macro. The categories must be completely independent, one may not be
400 subclassed from the other.
402 =for apidoc Am|bool|ckWARN2_d|U32 w1|U32 w2
404 Like C<L</ckWARN2>>, but for use if and only if either warning category is by
405 default enabled even if not within the scope of S<C<use warnings>>.
407 =for apidoc Am|bool|ckWARN3|U32 w1|U32 w2|U32 w3
409 Like C<L</ckWARN2>>, but takes three warnings categories as input, and returns
410 TRUE if any is enabled. If any of the categories is by default enabled even
411 if not within the scope of S<C<use warnings>>, instead use the L</ckWARN3_d>
412 macro. The categories must be completely independent, one may not be
413 subclassed from any other.
415 =for apidoc Am|bool|ckWARN3_d|U32 w1|U32 w2|U32 w3
417 Like C<L</ckWARN3>>, but for use if and only if any of the warning categories
418 is by default enabled even if not within the scope of S<C<use warnings>>.
420 =for apidoc Am|bool|ckWARN4|U32 w1|U32 w2|U32 w3|U32 w4
422 Like C<L</ckWARN3>>, but takes four warnings categories as input, and returns
423 TRUE if any is enabled. If any of the categories is by default enabled even
424 if not within the scope of S<C<use warnings>>, instead use the L</ckWARN4_d>
425 macro. The categories must be completely independent, one may not be
426 subclassed from any other.
428 =for apidoc Am|bool|ckWARN4_d|U32 w1|U32 w2|U32 w3|U32 w4
430 Like C<L</ckWARN4>>, but for use if and only if any of the warning categories
431 is by default enabled even if not within the scope of S<C<use warnings>>.
437 #define ckWARN(w) Perl_ckwarn(aTHX_ packWARN(w))
439 /* The w1, w2 ... should be independent warnings categories; one shouldn't be
440 * a subcategory of any other */
442 #define ckWARN2(w1,w2) Perl_ckwarn(aTHX_ packWARN2(w1,w2))
443 #define ckWARN3(w1,w2,w3) Perl_ckwarn(aTHX_ packWARN3(w1,w2,w3))
444 #define ckWARN4(w1,w2,w3,w4) Perl_ckwarn(aTHX_ packWARN4(w1,w2,w3,w4))
446 #define ckWARN_d(w) Perl_ckwarn_d(aTHX_ packWARN(w))
447 #define ckWARN2_d(w1,w2) Perl_ckwarn_d(aTHX_ packWARN2(w1,w2))
448 #define ckWARN3_d(w1,w2,w3) Perl_ckwarn_d(aTHX_ packWARN3(w1,w2,w3))
449 #define ckWARN4_d(w1,w2,w3,w4) Perl_ckwarn_d(aTHX_ packWARN4(w1,w2,w3,w4))
453 #define packWARN(a) (a )
455 /* The a, b, ... should be independent warnings categories; one shouldn't be
456 * a subcategory of any other */
458 #define packWARN2(a,b) ((a) | ((b)<<8) )
459 #define packWARN3(a,b,c) ((a) | ((b)<<8) | ((c)<<16) )
460 #define packWARN4(a,b,c,d) ((a) | ((b)<<8) | ((c)<<16) | ((d) <<24))
462 #define unpackWARN1(x) ((x) & 0xFF)
463 #define unpackWARN2(x) (((x) >>8) & 0xFF)
464 #define unpackWARN3(x) (((x) >>16) & 0xFF)
465 #define unpackWARN4(x) (((x) >>24) & 0xFF)
469 !specialWARN(PL_curcop->cop_warnings) && \
470 (isWARNf_on(PL_curcop->cop_warnings, unpackWARN1(x)) || \
472 (isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) || \
474 (isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) || \
476 isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x)))))))))
478 /* end of file warnings.h */
481 read_only_bottom_close_and_rename($warn);
485 last if /^VERSION$/ ;
489 print $pm qq(our \$VERSION = "$::VERSION";\n);
492 last if /^KEYWORDS$/ ;
497 print $pm "our %Offsets = (" ;
498 foreach my $k (sort { $a <=> $b } keys %ValueToName) {
499 my ($name, $version) = @{ $ValueToName{$k} };
502 if ( $last_ver != $version ) {
504 print $pm tab(6, " # Warnings Categories added in Perl $version");
507 print $pm tab(6, " '$name'"), "=> $k,\n" ;
508 $last_ver = $version;
513 print $pm "our %Bits = (\n" ;
514 foreach my $k (sort keys %list) {
517 my @list = sort { $a <=> $b } @$v ;
519 print $pm tab(6, " '$k'"), '=> "',
520 mkHex($warn_size, map $_ * 2 , @list),
521 '", # [', mkRange(@list), "]\n" ;
526 print $pm "our %DeadBits = (\n" ;
527 foreach my $k (sort keys %list) {
530 my @list = sort { $a <=> $b } @$v ;
532 print $pm tab(6, " '$k'"), '=> "',
533 mkHex($warn_size, map $_ * 2 + 1 , @list),
534 '", # [', mkRange(@list), "]\n" ;
538 print $pm "# These are used by various things, including our own tests\n";
539 print $pm tab(6, 'our $NONE'), '= "', ('\0' x $warn_size) , "\";\n" ;
540 print $pm tab(6, 'our $DEFAULT'), '= "', mkHex($warn_size, map $_ * 2, @def),
541 '", # [', mkRange(sort { $a <=> $b } @def), "]\n" ;
542 print $pm tab(6, 'our $LAST_BIT'), '= ' . "$index ;\n" ;
543 print $pm tab(6, 'our $BYTES'), '= ' . "$warn_size ;\n" ;
545 if ($_ eq "=for warnings.pl tree-goes-here\n") {
546 print $pm warningsTree($tree, " ");
552 read_only_bottom_close_and_rename($pm);
559 # Verify that we're called correctly so that warnings will work.
560 # Can't use Carp, since Carp uses us!
561 # String regexps because constant folding = smaller optree = less memory vs regexp literal
562 # see also strict.pm.
563 die sprintf "Incorrect use of pragma '%s' at %s line %d.\n", __PACKAGE__, +(caller)[1,2]
564 if __FILE__ !~ ( '(?x) \b '.__PACKAGE__.' \.pmc? \z' )
565 && __FILE__ =~ ( '(?x) \b (?i:'.__PACKAGE__.') \.pmc? \z' );
571 require Carp; # this initializes %CarpInternal
572 local $Carp::CarpInternal{'warnings'};
573 delete $Carp::CarpInternal{'warnings'};
579 my $want_len = ($LAST_BIT + 7) >> 3;
580 my $len = length($bits);
581 if ($len != $want_len) {
583 $bits = "\x00" x $want_len;
584 } elsif ($len > $want_len) {
585 substr $bits, $want_len, $len-$want_len, "";
587 my $a = vec($bits, $Offsets{all} >> 1, 2);
590 $bits .= chr($a) x ($want_len - $len);
602 $mask = _expand_bits($mask);
603 foreach my $word ( @_ ) {
604 if ($word eq 'FATAL') {
608 elsif ($word eq 'NONFATAL') {
612 elsif ($catmask = $Bits{$word}) {
614 $mask |= $DeadBits{$word} if $fatal ;
615 $mask = ~(~$mask | $DeadBits{$word}) if $no_fatal ;
618 { Croaker("Unknown warnings category '$word'")}
626 # called from B::Deparse.pm
627 push @_, 'all' unless @_ ;
628 return _bits("", @_) ;
635 my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
637 # append 'all' when implied (empty import list or after a lone
638 # "FATAL" or "NONFATAL")
640 if !@_ || (@_==1 && ($_[0] eq 'FATAL' || $_[0] eq 'NONFATAL'));
642 ${^WARNING_BITS} = _bits($mask, @_);
650 my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
652 # append 'all' when implied (empty import list or after a lone "FATAL")
653 push @_, 'all' if !@_ || @_==1 && $_[0] eq 'FATAL';
655 $mask = _expand_bits($mask);
656 foreach my $word ( @_ ) {
657 if ($word eq 'FATAL') {
660 elsif ($catmask = $Bits{$word}) {
661 $mask = ~(~$mask | $catmask | $DeadBits{$word});
664 { Croaker("Unknown warnings category '$word'")}
667 ${^WARNING_BITS} = $mask ;
670 my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
672 sub MESSAGE () { 4 };
682 my $has_message = $wanted & MESSAGE;
684 unless (@_ == 1 || @_ == ($has_message ? 2 : 0)) {
685 my $sub = (caller 1)[3];
686 my $syntax = $has_message ? "[category,] 'message'" : '[category]';
687 Croaker("Usage: $sub($syntax)");
690 my $message = pop if $has_message;
693 # check the category supplied.
695 if (my $type = ref $category) {
696 Croaker("not an object")
697 if exists $builtin_type{$type};
701 $offset = $Offsets{$category};
702 Croaker("Unknown warnings category '$category'")
703 unless defined $offset;
706 $category = (caller(1))[0] ;
707 $offset = $Offsets{$category};
708 Croaker("package '$category' not registered for warnings")
709 unless defined $offset ;
717 while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
718 last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
723 $i = _error_loc(); # see where Carp will allocate the error
726 # Default to 0 if caller returns nothing. Default to $DEFAULT if it
727 # explicitly returns undef.
728 my(@callers_bitmask) = (caller($i))[9] ;
729 my $callers_bitmask =
730 @callers_bitmask ? $callers_bitmask[0] // $DEFAULT : 0 ;
731 length($callers_bitmask) > ($offset >> 3) or $offset = $Offsets{all};
734 foreach my $type (FATAL, NORMAL) {
735 next unless $wanted & $type;
737 push @results, vec($callers_bitmask, $offset + $type - 1, 1);
740 # &enabled and &fatal_enabled
741 return $results[0] unless $has_message;
743 # &warnif, and the category is neither enabled as warning nor as fatal
744 return if $wanted == (NORMAL | FATAL | MESSAGE)
745 && !($results[0] || $results[1]);
748 Carp::croak($message) if $results[0];
749 # will always get here for &warn. will only get here for &warnif if the
750 # category is enabled
751 Carp::carp($message);
759 vec($mask, $bit, 1) = 1;
763 sub register_categories
767 for my $name (@names) {
768 if (! defined $Bits{$name}) {
769 $Offsets{$name} = $LAST_BIT;
770 $Bits{$name} = _mkMask($LAST_BIT++);
771 $DeadBits{$name} = _mkMask($LAST_BIT++);
772 if (length($Bits{$name}) > length($Bits{all})) {
773 $Bits{all} .= "\x55";
774 $DeadBits{all} .= "\xaa";
782 goto &Carp::short_error_loc; # don't introduce another stack frame
787 return __chk(NORMAL, @_);
792 return __chk(FATAL, @_);
797 return __chk(FATAL | MESSAGE, @_);
802 return __chk(NORMAL | FATAL | MESSAGE, @_);
805 # These are not part of any public interface, so we can delete them to save
807 delete @warnings::{qw(NORMAL FATAL MESSAGE)};
813 warnings - Perl pragma to control optional warnings
823 use warnings::register;
824 if (warnings::enabled()) {
825 warnings::warn("some warning");
828 if (warnings::enabled("void")) {
829 warnings::warn("void", "some warning");
832 if (warnings::enabled($object)) {
833 warnings::warn($object, "some warning");
836 warnings::warnif("some warning");
837 warnings::warnif("void", "some warning");
838 warnings::warnif($object, "some warning");
842 The C<warnings> pragma gives control over which warnings are enabled in
843 which parts of a Perl program. It's a more flexible alternative for
844 both the command line flag B<-w> and the equivalent Perl variable,
847 This pragma works just like the C<strict> pragma.
848 This means that the scope of the warning pragma is limited to the
849 enclosing block. It also means that the pragma setting will not
850 leak across files (via C<use>, C<require> or C<do>). This allows
851 authors to independently define the degree of warning checks that will
852 be applied to their module.
854 By default, optional warnings are disabled, so any legacy code that
855 doesn't attempt to control the warnings will work unchanged.
857 All warnings are enabled in a block by either of these:
862 Similarly all warnings are disabled in a block by either of these:
867 For example, consider the code below:
877 The code in the enclosing block has warnings enabled, but the inner
878 block has them disabled. In this case that means the assignment to the
879 scalar C<$c> will trip the C<"Scalar value @a[0] better written as $a[0]">
880 warning, but the assignment to the scalar C<$b> will not.
882 =head2 Default Warnings and Optional Warnings
884 Before the introduction of lexical warnings, Perl had two classes of
885 warnings: mandatory and optional.
887 As its name suggests, if your code tripped a mandatory warning, you
888 would get a warning whether you wanted it or not.
889 For example, the code below would always produce an C<"isn't numeric">
890 warning about the "2:".
894 With the introduction of lexical warnings, mandatory warnings now become
895 I<default> warnings. The difference is that although the previously
896 mandatory warnings are still enabled by default, they can then be
897 subsequently enabled or disabled with the lexical warning pragma. For
898 example, in the code below, an C<"isn't numeric"> warning will only
899 be reported for the C<$a> variable.
905 Note that neither the B<-w> flag or the C<$^W> can be used to
906 disable/enable default warnings. They are still mandatory in this case.
908 =head2 What's wrong with B<-w> and C<$^W>
910 Although very useful, the big problem with using B<-w> on the command
911 line to enable warnings is that it is all or nothing. Take the typical
912 scenario when you are writing a Perl program. Parts of the code you
913 will write yourself, but it's very likely that you will make use of
914 pre-written Perl modules. If you use the B<-w> flag in this case, you
915 end up enabling warnings in pieces of code that you haven't written.
917 Similarly, using C<$^W> to either disable or enable blocks of code is
918 fundamentally flawed. For a start, say you want to disable warnings in
919 a block of code. You might expect this to be enough to do the trick:
927 When this code is run with the B<-w> flag, a warning will be produced
928 for the C<$a> line: C<"Reversed += operator">.
930 The problem is that Perl has both compile-time and run-time warnings. To
931 disable compile-time warnings you need to rewrite the code like this:
939 The other big problem with C<$^W> is the way you can inadvertently
940 change the warning setting in unexpected places in your code. For example,
941 when the code below is run (without the B<-w> flag), the second call
942 to C<doit> will trip a C<"Use of uninitialized value"> warning, whereas
957 This is a side-effect of C<$^W> being dynamically scoped.
959 Lexical warnings get around these limitations by allowing finer control
960 over where warnings can or can't be tripped.
962 =head2 Controlling Warnings from the Command Line
964 There are three Command Line flags that can be used to control when
965 warnings are (or aren't) produced:
972 This is the existing flag. If the lexical warnings pragma is B<not>
973 used in any of you code, or any of the modules that you use, this flag
974 will enable warnings everywhere. See L<Backward Compatibility> for
975 details of how this flag interacts with lexical warnings.
980 If the B<-W> flag is used on the command line, it will enable all warnings
981 throughout the program regardless of whether warnings were disabled
982 locally using C<no warnings> or C<$^W =0>.
983 This includes all files that get
984 included via C<use>, C<require> or C<do>.
985 Think of it as the Perl equivalent of the "lint" command.
990 Does the exact opposite to the B<-W> flag, i.e. it disables all warnings.
994 =head2 Backward Compatibility
996 If you are used to working with a version of Perl prior to the
997 introduction of lexically scoped warnings, or have code that uses both
998 lexical warnings and C<$^W>, this section will describe how they interact.
1000 How Lexical Warnings interact with B<-w>/C<$^W>:
1006 If none of the three command line flags (B<-w>, B<-W> or B<-X>) that
1007 control warnings is used and neither C<$^W> nor the C<warnings> pragma
1008 are used, then default warnings will be enabled and optional warnings
1010 This means that legacy code that doesn't attempt to control the warnings
1011 will work unchanged.
1015 The B<-w> flag just sets the global C<$^W> variable as in 5.005. This
1016 means that any legacy code that currently relies on manipulating C<$^W>
1017 to control warning behavior will still work as is.
1021 Apart from now being a boolean, the C<$^W> variable operates in exactly
1022 the same horrible uncontrolled global way, except that it cannot
1023 disable/enable default warnings.
1027 If a piece of code is under the control of the C<warnings> pragma,
1028 both the C<$^W> variable and the B<-w> flag will be ignored for the
1029 scope of the lexical warning.
1033 The only way to override a lexical warnings setting is with the B<-W>
1034 or B<-X> command line flags.
1038 The combined effect of 3 & 4 is that it will allow code which uses
1039 the C<warnings> pragma to control the warning behavior of $^W-type
1040 code (using a C<local $^W=0>) if it really wants to, but not vice-versa.
1042 =head2 Category Hierarchy
1043 X<warning, categories>
1045 A hierarchy of "categories" have been defined to allow groups of warnings
1046 to be enabled/disabled in isolation.
1048 The current hierarchy is:
1050 =for warnings.pl tree-goes-here
1052 Just like the "strict" pragma any of these categories can be combined
1054 use warnings qw(void redefine);
1055 no warnings qw(io syntax untie);
1057 Also like the "strict" pragma, if there is more than one instance of the
1058 C<warnings> pragma in a given scope the cumulative effect is additive.
1060 use warnings qw(void); # only "void" warnings enabled
1062 use warnings qw(io); # only "void" & "io" warnings enabled
1064 no warnings qw(void); # only "io" warnings enabled
1066 To determine which category a specific warning has been assigned to see
1069 Note: Before Perl 5.8.0, the lexical warnings category "deprecated" was a
1070 sub-category of the "syntax" category. It is now a top-level category
1073 Note: Before 5.21.0, the "missing" lexical warnings category was
1074 internally defined to be the same as the "uninitialized" category. It
1075 is now a top-level category in its own right.
1077 =head2 Fatal Warnings
1080 The presence of the word "FATAL" in the category list will escalate
1081 warnings in those categories into fatal errors in that lexical scope.
1083 B<NOTE:> FATAL warnings should be used with care, particularly
1084 C<< FATAL => 'all' >>.
1086 Libraries using L<warnings::warn|/FUNCTIONS> for custom warning categories
1087 generally don't expect L<warnings::warn|/FUNCTIONS> to be fatal and can wind up
1088 in an unexpected state as a result. For XS modules issuing categorized
1089 warnings, such unanticipated exceptions could also expose memory leak bugs.
1091 Moreover, the Perl interpreter itself has had serious bugs involving
1092 fatalized warnings. For a summary of resolved and unresolved problems as
1093 of January 2015, please see
1094 L<this perl5-porters post|http://www.nntp.perl.org/group/perl.perl5.porters/2015/01/msg225235.html>.
1096 While some developers find fatalizing some warnings to be a useful
1097 defensive programming technique, using C<< FATAL => 'all' >> to fatalize
1098 all possible warning categories -- including custom ones -- is particularly
1099 risky. Therefore, the use of C<< FATAL => 'all' >> is
1100 L<discouraged|perlpolicy/discouraged>.
1102 The L<strictures|strictures/VERSION-2> module on CPAN offers one example of
1103 a warnings subset that the module's authors believe is relatively safe to
1106 B<NOTE:> users of FATAL warnings, especially those using
1107 C<< FATAL => 'all' >>, should be fully aware that they are risking future
1108 portability of their programs by doing so. Perl makes absolutely no
1109 commitments to not introduce new warnings or warnings categories in the
1110 future; indeed, we explicitly reserve the right to do so. Code that may
1111 not warn now may warn in a future release of Perl if the Perl5 development
1112 team deems it in the best interests of the community to do so. Should code
1113 using FATAL warnings break due to the introduction of a new warning we will
1114 NOT consider it an incompatible change. Users of FATAL warnings should
1115 take special caution during upgrades to check to see if their code triggers
1116 any new warnings and should pay particular attention to the fine print of
1117 the documentation of the features they use to ensure they do not exploit
1118 features that are documented as risky, deprecated, or unspecified, or where
1119 the documentation says "so don't do that", or anything with the same sense
1120 and spirit. Use of such features in combination with FATAL warnings is
1121 ENTIRELY AT THE USER'S RISK.
1123 The following documentation describes how to use FATAL warnings but the
1124 perl5 porters strongly recommend that you understand the risks before doing
1125 so, especially for library code intended for use by others, as there is no
1126 way for downstream users to change the choice of fatal categories.
1128 In the code below, the use of C<time>, C<length>
1129 and C<join> can all produce a C<"Useless use of xxx in void context">
1137 use warnings FATAL => qw(void);
1145 When run it produces this output
1147 Useless use of time in void context at fatal line 3.
1148 Useless use of length in void context at fatal line 7.
1150 The scope where C<length> is used has escalated the C<void> warnings
1151 category into a fatal error, so the program terminates immediately when it
1152 encounters the warning.
1154 To explicitly turn off a "FATAL" warning you just disable the warning
1155 it is associated with. So, for example, to disable the "void" warning
1156 in the example above, either of these will do the trick:
1158 no warnings qw(void);
1159 no warnings FATAL => qw(void);
1161 If you want to downgrade a warning that has been escalated into a fatal
1162 error back to a normal warning, you can use the "NONFATAL" keyword. For
1163 example, the code below will promote all warnings into fatal errors,
1164 except for those in the "syntax" category.
1166 use warnings FATAL => 'all', NONFATAL => 'syntax';
1168 As of Perl 5.20, instead of C<< use warnings FATAL => 'all'; >> you can
1171 use v5.20; # Perl 5.20 or greater is required for the following
1172 use warnings 'FATAL'; # short form of "use warnings FATAL => 'all';"
1174 If you want your program to be compatible with versions of Perl before
1175 5.20, you must use C<< use warnings FATAL => 'all'; >> instead. (In
1176 previous versions of Perl, the behavior of the statements
1177 C<< use warnings 'FATAL'; >>, C<< use warnings 'NONFATAL'; >> and
1178 C<< no warnings 'FATAL'; >> was unspecified; they did not behave as if
1179 they included the C<< => 'all' >> portion. As of 5.20, they do.)
1181 =head2 Reporting Warnings from a Module
1182 X<warning, reporting> X<warning, registering>
1184 The C<warnings> pragma provides a number of functions that are useful for
1185 module authors. These are used when you want to report a module-specific
1186 warning to a calling module has enabled warnings via the C<warnings>
1189 Consider the module C<MyMod::Abc> below.
1193 use warnings::register;
1197 if ($path !~ m#^/#) {
1198 warnings::warn("changing relative path to /var/abc")
1199 if warnings::enabled();
1200 $path = "/var/abc/$path";
1206 The call to C<warnings::register> will create a new warnings category
1207 called "MyMod::Abc", i.e. the new category name matches the current
1208 package name. The C<open> function in the module will display a warning
1209 message if it gets given a relative path as a parameter. This warnings
1210 will only be displayed if the code that uses C<MyMod::Abc> has actually
1211 enabled them with the C<warnings> pragma like below.
1214 use warnings 'MyMod::Abc';
1216 abc::open("../fred.txt");
1218 It is also possible to test whether the pre-defined warnings categories are
1219 set in the calling module with the C<warnings::enabled> function. Consider
1220 this snippet of code:
1225 if (warnings::enabled("deprecated")) {
1226 warnings::warn("deprecated",
1227 "open is deprecated, use new instead");
1236 The function C<open> has been deprecated, so code has been included to
1237 display a warning message whenever the calling module has (at least) the
1238 "deprecated" warnings category enabled. Something like this, say.
1240 use warnings 'deprecated';
1243 MyMod::Abc::open($filename);
1245 Either the C<warnings::warn> or C<warnings::warnif> function should be
1246 used to actually display the warnings message. This is because they can
1247 make use of the feature that allows warnings to be escalated into fatal
1248 errors. So in this case
1251 use warnings FATAL => 'MyMod::Abc';
1253 MyMod::Abc::open('../fred.txt');
1255 the C<warnings::warnif> function will detect this and die after
1256 displaying the warning message.
1258 The three warnings functions, C<warnings::warn>, C<warnings::warnif>
1259 and C<warnings::enabled> can optionally take an object reference in place
1260 of a category name. In this case the functions will use the class name
1261 of the object as the warnings category.
1263 Consider this example:
1268 use warnings::register;
1281 if ($value % 2 && warnings::enabled($self))
1282 { warnings::warn($self, "Odd numbers are unsafe") }
1289 $self->check($value);
1297 use warnings::register;
1299 our @ISA = qw( Original );
1309 The code below makes use of both modules, but it only enables warnings from
1314 use warnings 'Derived';
1315 my $a = Original->new();
1317 my $b = Derived->new();
1320 When this code is run only the C<Derived> object, C<$b>, will generate
1323 Odd numbers are unsafe at main.pl line 7
1325 Notice also that the warning is reported at the line where the object is first
1328 When registering new categories of warning, you can supply more names to
1329 warnings::register like this:
1332 use warnings::register qw(format precision);
1336 warnings::warnif('MyModule::format', '...');
1342 =item use warnings::register
1344 Creates a new warnings category with the same name as the package where
1345 the call to the pragma is used.
1347 =item warnings::enabled()
1349 Use the warnings category with the same name as the current package.
1351 Return TRUE if that warnings category is enabled in the calling module.
1352 Otherwise returns FALSE.
1354 =item warnings::enabled($category)
1356 Return TRUE if the warnings category, C<$category>, is enabled in the
1358 Otherwise returns FALSE.
1360 =item warnings::enabled($object)
1362 Use the name of the class for the object reference, C<$object>, as the
1365 Return TRUE if that warnings category is enabled in the first scope
1366 where the object is used.
1367 Otherwise returns FALSE.
1369 =item warnings::fatal_enabled()
1371 Return TRUE if the warnings category with the same name as the current
1372 package has been set to FATAL in the calling module.
1373 Otherwise returns FALSE.
1375 =item warnings::fatal_enabled($category)
1377 Return TRUE if the warnings category C<$category> has been set to FATAL in
1379 Otherwise returns FALSE.
1381 =item warnings::fatal_enabled($object)
1383 Use the name of the class for the object reference, C<$object>, as the
1386 Return TRUE if that warnings category has been set to FATAL in the first
1387 scope where the object is used.
1388 Otherwise returns FALSE.
1390 =item warnings::warn($message)
1392 Print C<$message> to STDERR.
1394 Use the warnings category with the same name as the current package.
1396 If that warnings category has been set to "FATAL" in the calling module
1397 then die. Otherwise return.
1399 =item warnings::warn($category, $message)
1401 Print C<$message> to STDERR.
1403 If the warnings category, C<$category>, has been set to "FATAL" in the
1404 calling module then die. Otherwise return.
1406 =item warnings::warn($object, $message)
1408 Print C<$message> to STDERR.
1410 Use the name of the class for the object reference, C<$object>, as the
1413 If that warnings category has been set to "FATAL" in the scope where C<$object>
1414 is first used then die. Otherwise return.
1417 =item warnings::warnif($message)
1421 if (warnings::enabled())
1422 { warnings::warn($message) }
1424 =item warnings::warnif($category, $message)
1428 if (warnings::enabled($category))
1429 { warnings::warn($category, $message) }
1431 =item warnings::warnif($object, $message)
1435 if (warnings::enabled($object))
1436 { warnings::warn($object, $message) }
1438 =item warnings::register_categories(@names)
1440 This registers warning categories for the given names and is primarily for
1441 use by the warnings::register pragma.
1445 See also L<perlmodlib/Pragmatic Modules> and L<perldiag>.