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 ],
110 'experimental::script_run' =>
111 [ 5.027, DEFAULT_ON ],
112 'experimental::alpha_assertions' =>
113 [ 5.027, DEFAULT_ON ],
114 'experimental::private_use' =>
115 [ 5.029, DEFAULT_ON ],
116 'experimental::uniprop_wildcards' =>
117 [ 5.029, DEFAULT_ON ],
118 'experimental::vlb' =>
119 [ 5.029, DEFAULT_ON ],
120 'experimental::isa' =>
121 [ 5.031, DEFAULT_ON ],
124 'missing' => [ 5.021, DEFAULT_OFF],
125 'redundant' => [ 5.021, DEFAULT_OFF],
126 'locale' => [ 5.021, DEFAULT_ON],
127 'shadow' => [ 5.027, DEFAULT_OFF],
129 #'default' => [ 5.008, DEFAULT_ON ],
146 foreach $k (sort keys %$tre) {
148 die "duplicate key $k\n" if defined $list{$k} ;
149 die "Value associated with key '$k' is not an ARRAY reference"
150 if !ref $v || ref $v ne 'ARRAY' ;
152 my ($ver, $rest) = @{ $v } ;
153 push @{ $v_list{$ver} }, $k;
156 { valueWalk ($rest) }
165 foreach my $ver ( sort { $a <=> $b } keys %v_list ) {
166 foreach my $name (@{ $v_list{$ver} } ) {
167 $ValueToName{ $index } = [ uc $name, $ver ] ;
168 $NameToValue{ uc $name } = $index ++ ;
175 ###########################################################################
183 foreach $k (sort keys %$tre) {
185 die "duplicate key $k\n" if defined $list{$k} ;
186 die "Can't find key '$k'"
187 if ! defined $NameToValue{uc $k} ;
188 push @{ $list{$k} }, $NameToValue{uc $k} ;
189 die "Value associated with key '$k' is not an ARRAY reference"
190 if !ref $v || ref $v ne 'ARRAY' ;
192 my ($ver, $rest) = @{ $v } ;
194 { push (@{ $list{$k} }, walk ($rest)) }
195 elsif ($rest == DEFAULT_ON)
196 { push @def, $NameToValue{uc $k} }
198 push @list, @{ $list{$k} } ;
204 ###########################################################################
211 for my $i (1 .. @in - 1) {
213 if $in[$i] == $in[$i - 1] + 1
214 && ($i >= @in - 1 || $in[$i] + 1 == $in[$i + 1] );
216 $out[-1] = $in[-1] if $out[-1] eq "..";
218 my $out = join(",",@out);
220 $out =~ s/,(\.\.,)+/../g ;
224 ###########################################################################
231 my $max = (sort {$a <=> $b} map { length $_ } keys %$tre)[-1] ;
232 my @keys = sort keys %$tre ;
236 while ($k = shift @keys) {
238 die "Value associated with key '$k' is not an ARRAY reference"
239 if !ref $v || ref $v ne 'ARRAY' ;
243 $rv .= $prefix . "|\n" ;
244 $rv .= $prefix . "+- $k" ;
245 $offset = ' ' x ($max + 4) ;
248 $rv .= $prefix . "$k" ;
249 $offset = ' ' x ($max + 1) ;
252 my ($ver, $rest) = @{ $v } ;
255 my $bar = @keys ? "|" : " ";
256 $rv .= " -" . "-" x ($max - length $k ) . "+\n" ;
257 $rv .= warningsTree ($rest, $prefix . $bar . $offset )
266 ###########################################################################
270 my ($f, $max, @bits) = @_ ;
271 my $mask = "\x00" x $max ;
275 vec($mask, $_, 1) = 1 ;
278 foreach (unpack("C*", $mask)) {
280 $string .= '\x' . sprintf("%2.2x", $_)
283 $string .= '\\' . sprintf("%o", $_)
291 my($max, @bits) = @_;
292 return mkHexOct("x", $max, @bits);
297 my($max, @bits) = @_;
298 return mkHexOct("o", $max, @bits);
301 ###########################################################################
303 if (@ARGV && $ARGV[0] eq "tree")
305 print warningsTree($tree, " ") ;
309 my ($warn, $pm) = map {
310 open_new($_, '>', { by => 'regen/warnings.pl' });
311 } 'warnings.h', 'lib/warnings.pm';
313 my ($index, $warn_size);
316 # generate warnings.h
320 #define Off(x) ((x) / 8)
321 #define Bit(x) (1 << ((x) % 8))
322 #define IsSet(a, x) ((a)[Off(x)] & Bit(x))
325 #define G_WARN_OFF 0 /* $^W == 0 */
326 #define G_WARN_ON 1 /* -w flag and $^W != 0 */
327 #define G_WARN_ALL_ON 2 /* -W flag */
328 #define G_WARN_ALL_OFF 4 /* -X flag */
329 #define G_WARN_ONCE 8 /* set if 'once' ever enabled */
330 #define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF)
332 #define pWARN_STD NULL
333 #define pWARN_ALL (STRLEN *) &PL_WARN_ALL /* use warnings 'all' */
334 #define pWARN_NONE (STRLEN *) &PL_WARN_NONE /* no warnings 'all' */
336 #define specialWARN(x) ((x) == pWARN_STD || (x) == pWARN_ALL || \
339 /* if PL_warnhook is set to this value, then warnings die */
340 #define PERL_WARNHOOK_FATAL (&PL_sv_placeholder)
346 $index = orderValues();
348 die <<EOM if $index > 255 ;
349 Too many warnings categories -- max is 255
350 rewrite packWARN* & unpackWARN* macros
354 for (my $i = $index; $i & 3; $i++) {
355 push @{$list{all}}, $i;
359 $warn_size = int($index / 8) + ($index % 8 != 0) ;
364 foreach $k (sort { $a <=> $b } keys %ValueToName) {
365 my ($name, $version) = @{ $ValueToName{$k} };
366 print $warn "\n/* Warnings Categories added in Perl $version */\n\n"
367 if $last_ver != $version ;
369 $name = "WARN_$name";
370 print $warn tab(6, "#define $name"), " $k\n" ;
372 $last_ver = $version ;
375 print $warn tab(6, '#define WARNsize'), " $warn_size\n" ;
376 print $warn tab(6, '#define WARN_ALLstring'), ' "', ('\125' x $warn_size) , "\"\n" ;
377 print $warn tab(6, '#define WARN_NONEstring'), ' "', ('\0' x $warn_size) , "\"\n" ;
381 #define isLEXWARN_on \
382 cBOOL(PL_curcop && PL_curcop->cop_warnings != pWARN_STD)
383 #define isLEXWARN_off \
384 cBOOL(!PL_curcop || PL_curcop->cop_warnings == pWARN_STD)
385 #define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
386 #define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)))
387 #define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1))
389 #define DUP_WARNINGS(p) Perl_dup_warnings(aTHX_ p)
391 #define free_and_set_cop_warnings(cmp,w) STMT_START { \
392 if (!specialWARN((cmp)->cop_warnings)) PerlMemShared_free((cmp)->cop_warnings); \
393 (cmp)->cop_warnings = w; \
398 =head1 Warning and Dieing
400 In all these calls, the C<U32 wI<n>> parameters are warning category
401 constants. You can see the ones currently available in
402 L<warnings/Category Hierarchy>, just capitalize all letters in the names
403 and prefix them by C<WARN_>. So, for example, the category C<void> used in a
404 perl program becomes C<WARN_VOID> when used in XS code and passed to one of
407 =for apidoc Am|bool|ckWARN|U32 w
408 =for apidoc_item ||ckWARN2|U32 w1|U32 w2
409 =for apidoc_item ||ckWARN3|U32 w1|U32 w2|U32 w3
410 =for apidoc_item ||ckWARN4|U32 w1|U32 w2|U32 w3|U32 w4
411 These return a boolean as to whether or not warnings are enabled for any of
412 the warning category(ies) parameters: C<w>, C<w1>, ....
414 Should any of the categories by default be enabled even if not within the
415 scope of S<C<use warnings>>, instead use the C<L</ckWARN_d>> macros.
417 The categories must be completely independent, one may not be subclassed from
420 =for apidoc Am|bool|ckWARN_d|U32 w
421 =for apidoc_item ||ckWARN2_d|U32 w1|U32 w2
422 =for apidoc_item ||ckWARN3_d|U32 w1|U32 w2|U32 w3
423 =for apidoc_item ||ckWARN4_d|U32 w1|U32 w2|U32 w3|U32 w4
425 Like C<L</ckWARN>>, but for use if and only if the warning category(ies) is by
426 default enabled even if not within the scope of S<C<use warnings>>.
428 =for apidoc Am|U32|packWARN|U32 w1
429 =for apidoc_item ||packWARN2|U32 w1|U32 w2
430 =for apidoc_item ||packWARN3|U32 w1|U32 w2|U32 w3
431 =for apidoc_item ||packWARN4|U32 w1|U32 w2|U32 w3|U32 w4
433 These macros are used to pack warning categories into a single U32 to pass to
434 macros and functions that take a warning category parameter. The number of
435 categories to pack is given by the name, with a corresponding number of
436 category parameters passed.
442 #define ckWARN(w) Perl_ckwarn(aTHX_ packWARN(w))
444 /* The w1, w2 ... should be independent warnings categories; one shouldn't be
445 * a subcategory of any other */
447 #define ckWARN2(w1,w2) Perl_ckwarn(aTHX_ packWARN2(w1,w2))
448 #define ckWARN3(w1,w2,w3) Perl_ckwarn(aTHX_ packWARN3(w1,w2,w3))
449 #define ckWARN4(w1,w2,w3,w4) Perl_ckwarn(aTHX_ packWARN4(w1,w2,w3,w4))
451 #define ckWARN_d(w) Perl_ckwarn_d(aTHX_ packWARN(w))
452 #define ckWARN2_d(w1,w2) Perl_ckwarn_d(aTHX_ packWARN2(w1,w2))
453 #define ckWARN3_d(w1,w2,w3) Perl_ckwarn_d(aTHX_ packWARN3(w1,w2,w3))
454 #define ckWARN4_d(w1,w2,w3,w4) Perl_ckwarn_d(aTHX_ packWARN4(w1,w2,w3,w4))
458 #define packWARN(a) (a )
460 /* The a, b, ... should be independent warnings categories; one shouldn't be
461 * a subcategory of any other */
463 #define packWARN2(a,b) ((a) | ((b)<<8) )
464 #define packWARN3(a,b,c) ((a) | ((b)<<8) | ((c)<<16) )
465 #define packWARN4(a,b,c,d) ((a) | ((b)<<8) | ((c)<<16) | ((d) <<24))
467 #define unpackWARN1(x) ((x) & 0xFF)
468 #define unpackWARN2(x) (((x) >>8) & 0xFF)
469 #define unpackWARN3(x) (((x) >>16) & 0xFF)
470 #define unpackWARN4(x) (((x) >>24) & 0xFF)
474 !specialWARN(PL_curcop->cop_warnings) && \
475 (isWARNf_on(PL_curcop->cop_warnings, unpackWARN1(x)) || \
477 (isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) || \
479 (isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) || \
481 isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x)))))))))
485 print $warn "\n\n/*\n" ;
486 print $warn map { "=for apidoc Amnh||$_\n" } @names;
487 print $warn "\n=cut\n*/\n\n" ;
488 print $warn "/* end of file warnings.h */\n";
490 read_only_bottom_close_and_rename($warn);
494 last if /^VERSION$/ ;
498 print $pm qq(our \$VERSION = "$::VERSION";\n);
501 last if /^KEYWORDS$/ ;
506 print $pm "our %Offsets = (" ;
507 foreach my $k (sort { $a <=> $b } keys %ValueToName) {
508 my ($name, $version) = @{ $ValueToName{$k} };
511 if ( $last_ver != $version ) {
513 print $pm tab(6, " # Warnings Categories added in Perl $version");
516 print $pm tab(6, " '$name'"), "=> $k,\n" ;
517 $last_ver = $version;
522 print $pm "our %Bits = (\n" ;
523 foreach my $k (sort keys %list) {
526 my @list = sort { $a <=> $b } @$v ;
528 print $pm tab(6, " '$k'"), '=> "',
529 mkHex($warn_size, map $_ * 2 , @list),
530 '", # [', mkRange(@list), "]\n" ;
535 print $pm "our %DeadBits = (\n" ;
536 foreach my $k (sort keys %list) {
539 my @list = sort { $a <=> $b } @$v ;
541 print $pm tab(6, " '$k'"), '=> "',
542 mkHex($warn_size, map $_ * 2 + 1 , @list),
543 '", # [', mkRange(@list), "]\n" ;
547 print $pm "# These are used by various things, including our own tests\n";
548 print $pm tab(6, 'our $NONE'), '= "', ('\0' x $warn_size) , "\";\n" ;
549 print $pm tab(6, 'our $DEFAULT'), '= "', mkHex($warn_size, map $_ * 2, @def),
550 '"; # [', mkRange(sort { $a <=> $b } @def), "]\n" ;
551 print $pm tab(6, 'our $LAST_BIT'), '= ' . "$index ;\n" ;
552 print $pm tab(6, 'our $BYTES'), '= ' . "$warn_size ;\n" ;
554 if ($_ eq "=for warnings.pl tree-goes-here\n") {
555 print $pm warningsTree($tree, " ");
561 read_only_bottom_close_and_rename($pm);
568 # Verify that we're called correctly so that warnings will work.
569 # Can't use Carp, since Carp uses us!
570 # String regexps because constant folding = smaller optree = less memory vs regexp literal
571 # see also strict.pm.
572 die sprintf "Incorrect use of pragma '%s' at %s line %d.\n", __PACKAGE__, +(caller)[1,2]
573 if __FILE__ !~ ( '(?x) \b '.__PACKAGE__.' \.pmc? \z' )
574 && __FILE__ =~ ( '(?x) \b (?i:'.__PACKAGE__.') \.pmc? \z' );
580 require Carp; # this initializes %CarpInternal
581 local $Carp::CarpInternal{'warnings'};
582 delete $Carp::CarpInternal{'warnings'};
588 my $want_len = ($LAST_BIT + 7) >> 3;
589 my $len = length($bits);
590 if ($len != $want_len) {
592 $bits = "\x00" x $want_len;
593 } elsif ($len > $want_len) {
594 substr $bits, $want_len, $len-$want_len, "";
596 my $x = vec($bits, $Offsets{all} >> 1, 2);
599 $bits .= chr($x) x ($want_len - $len);
611 $mask = _expand_bits($mask);
612 foreach my $word ( @_ ) {
613 if ($word eq 'FATAL') {
617 elsif ($word eq 'NONFATAL') {
621 elsif ($catmask = $Bits{$word}) {
623 $mask |= $DeadBits{$word} if $fatal ;
624 $mask = ~(~$mask | $DeadBits{$word}) if $no_fatal ;
627 { Croaker("Unknown warnings category '$word'")}
635 # called from B::Deparse.pm
636 push @_, 'all' unless @_ ;
637 return _bits("", @_) ;
644 my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
646 # append 'all' when implied (empty import list or after a lone
647 # "FATAL" or "NONFATAL")
649 if !@_ || (@_==1 && ($_[0] eq 'FATAL' || $_[0] eq 'NONFATAL'));
651 ${^WARNING_BITS} = _bits($mask, @_);
659 my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
661 # append 'all' when implied (empty import list or after a lone "FATAL")
662 push @_, 'all' if !@_ || @_==1 && $_[0] eq 'FATAL';
664 $mask = _expand_bits($mask);
665 foreach my $word ( @_ ) {
666 if ($word eq 'FATAL') {
669 elsif ($catmask = $Bits{$word}) {
670 $mask = ~(~$mask | $catmask | $DeadBits{$word});
673 { Croaker("Unknown warnings category '$word'")}
676 ${^WARNING_BITS} = $mask ;
679 my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
682 sub MESSAGE () { 4 };
692 my $has_message = $wanted & MESSAGE;
693 my $has_level = $wanted & LEVEL ;
696 if (@_ != ($has_message ? 3 : 2)) {
697 my $sub = (caller 1)[3];
698 my $syntax = $has_message
699 ? "category, level, 'message'"
701 Croaker("Usage: $sub($syntax)");
704 elsif (not @_ == 1 || @_ == ($has_message ? 2 : 0)) {
705 my $sub = (caller 1)[3];
706 my $syntax = $has_message ? "[category,] 'message'" : '[category]';
707 Croaker("Usage: $sub($syntax)");
710 my $message = pop if $has_message;
713 # check the category supplied.
715 if (my $type = ref $category) {
716 Croaker("not an object")
717 if exists $builtin_type{$type};
721 $offset = $Offsets{$category};
722 Croaker("Unknown warnings category '$category'")
723 unless defined $offset;
726 $category = (caller(1))[0] ;
727 $offset = $Offsets{$category};
728 Croaker("package '$category' not registered for warnings")
729 unless defined $offset ;
737 while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
738 last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
746 $i = _error_loc(); # see where Carp will allocate the error
749 # Default to 0 if caller returns nothing. Default to $DEFAULT if it
750 # explicitly returns undef.
751 my(@callers_bitmask) = (caller($i))[9] ;
752 my $callers_bitmask =
753 @callers_bitmask ? $callers_bitmask[0] // $DEFAULT : 0 ;
754 length($callers_bitmask) > ($offset >> 3) or $offset = $Offsets{all};
757 foreach my $type (FATAL, NORMAL) {
758 next unless $wanted & $type;
760 push @results, vec($callers_bitmask, $offset + $type - 1, 1);
763 # &enabled and &fatal_enabled
764 return $results[0] unless $has_message;
766 # &warnif, and the category is neither enabled as warning nor as fatal
767 return if ($wanted & (NORMAL | FATAL | MESSAGE))
768 == (NORMAL | FATAL | MESSAGE)
769 && !($results[0] || $results[1]);
771 # If we have an explicit level, bypass Carp.
772 if ($has_level and @callers_bitmask) {
773 # logic copied from util.c:mess_sv
774 my $stuff = " at " . join " line ", (caller $i)[1,2];
775 $stuff .= sprintf ", <%s> %s %d",
777 ($/ eq "\n" ? "line" : "chunk"), $.
778 if $. && ${^LAST_FH};
779 die "$message$stuff.\n" if $results[0];
780 return warn "$message$stuff.\n";
784 Carp::croak($message) if $results[0];
785 # will always get here for &warn. will only get here for &warnif if the
786 # category is enabled
787 Carp::carp($message);
795 vec($mask, $bit, 1) = 1;
799 sub register_categories
803 for my $name (@names) {
804 if (! defined $Bits{$name}) {
805 $Offsets{$name} = $LAST_BIT;
806 $Bits{$name} = _mkMask($LAST_BIT++);
807 $DeadBits{$name} = _mkMask($LAST_BIT++);
808 if (length($Bits{$name}) > length($Bits{all})) {
809 $Bits{all} .= "\x55";
810 $DeadBits{all} .= "\xaa";
818 goto &Carp::short_error_loc; # don't introduce another stack frame
823 return __chk(NORMAL, @_);
828 return __chk(FATAL, @_);
833 return __chk(FATAL | MESSAGE, @_);
838 return __chk(NORMAL | FATAL | MESSAGE, @_);
843 return __chk(NORMAL | LEVEL, @_);
846 sub fatal_enabled_at_level
848 return __chk(FATAL | LEVEL, @_);
853 return __chk(FATAL | MESSAGE | LEVEL, @_);
858 return __chk(NORMAL | FATAL | MESSAGE | LEVEL, @_);
861 # These are not part of any public interface, so we can delete them to save
863 delete @warnings::{qw(NORMAL FATAL MESSAGE LEVEL)};
870 warnings - Perl pragma to control optional warnings
880 use warnings::register;
881 if (warnings::enabled()) {
882 warnings::warn("some warning");
885 if (warnings::enabled("void")) {
886 warnings::warn("void", "some warning");
889 if (warnings::enabled($object)) {
890 warnings::warn($object, "some warning");
893 warnings::warnif("some warning");
894 warnings::warnif("void", "some warning");
895 warnings::warnif($object, "some warning");
899 The C<warnings> pragma gives control over which warnings are enabled in
900 which parts of a Perl program. It's a more flexible alternative for
901 both the command line flag B<-w> and the equivalent Perl variable,
904 This pragma works just like the C<strict> pragma.
905 This means that the scope of the warning pragma is limited to the
906 enclosing block. It also means that the pragma setting will not
907 leak across files (via C<use>, C<require> or C<do>). This allows
908 authors to independently define the degree of warning checks that will
909 be applied to their module.
911 By default, optional warnings are disabled, so any legacy code that
912 doesn't attempt to control the warnings will work unchanged.
914 All warnings are enabled in a block by either of these:
919 Similarly all warnings are disabled in a block by either of these:
924 For example, consider the code below:
934 The code in the enclosing block has warnings enabled, but the inner
935 block has them disabled. In this case that means the assignment to the
936 scalar C<$z> will trip the C<"Scalar value @x[0] better written as $x[0]">
937 warning, but the assignment to the scalar C<$y> will not.
939 =head2 Default Warnings and Optional Warnings
941 Before the introduction of lexical warnings, Perl had two classes of
942 warnings: mandatory and optional.
944 As its name suggests, if your code tripped a mandatory warning, you
945 would get a warning whether you wanted it or not.
946 For example, the code below would always produce an C<"isn't numeric">
947 warning about the "2:".
951 With the introduction of lexical warnings, mandatory warnings now become
952 I<default> warnings. The difference is that although the previously
953 mandatory warnings are still enabled by default, they can then be
954 subsequently enabled or disabled with the lexical warning pragma. For
955 example, in the code below, an C<"isn't numeric"> warning will only
956 be reported for the C<$x> variable.
962 Note that neither the B<-w> flag or the C<$^W> can be used to
963 disable/enable default warnings. They are still mandatory in this case.
965 =head2 What's wrong with B<-w> and C<$^W>
967 Although very useful, the big problem with using B<-w> on the command
968 line to enable warnings is that it is all or nothing. Take the typical
969 scenario when you are writing a Perl program. Parts of the code you
970 will write yourself, but it's very likely that you will make use of
971 pre-written Perl modules. If you use the B<-w> flag in this case, you
972 end up enabling warnings in pieces of code that you haven't written.
974 Similarly, using C<$^W> to either disable or enable blocks of code is
975 fundamentally flawed. For a start, say you want to disable warnings in
976 a block of code. You might expect this to be enough to do the trick:
984 When this code is run with the B<-w> flag, a warning will be produced
985 for the C<$x> line: C<"Reversed += operator">.
987 The problem is that Perl has both compile-time and run-time warnings. To
988 disable compile-time warnings you need to rewrite the code like this:
996 And note that unlike the first example, this will permanently set C<$^W>
997 since it cannot both run during compile-time and be localized to a
1000 The other big problem with C<$^W> is the way you can inadvertently
1001 change the warning setting in unexpected places in your code. For example,
1002 when the code below is run (without the B<-w> flag), the second call
1003 to C<doit> will trip a C<"Use of uninitialized value"> warning, whereas
1018 This is a side-effect of C<$^W> being dynamically scoped.
1020 Lexical warnings get around these limitations by allowing finer control
1021 over where warnings can or can't be tripped.
1023 =head2 Controlling Warnings from the Command Line
1025 There are three Command Line flags that can be used to control when
1026 warnings are (or aren't) produced:
1033 This is the existing flag. If the lexical warnings pragma is B<not>
1034 used in any of your code, or any of the modules that you use, this flag
1035 will enable warnings everywhere. See L</Backward Compatibility> for
1036 details of how this flag interacts with lexical warnings.
1041 If the B<-W> flag is used on the command line, it will enable all warnings
1042 throughout the program regardless of whether warnings were disabled
1043 locally using C<no warnings> or C<$^W =0>.
1044 This includes all files that get
1045 included via C<use>, C<require> or C<do>.
1046 Think of it as the Perl equivalent of the "lint" command.
1051 Does the exact opposite to the B<-W> flag, i.e. it disables all warnings.
1055 =head2 Backward Compatibility
1057 If you are used to working with a version of Perl prior to the
1058 introduction of lexically scoped warnings, or have code that uses both
1059 lexical warnings and C<$^W>, this section will describe how they interact.
1061 How Lexical Warnings interact with B<-w>/C<$^W>:
1067 If none of the three command line flags (B<-w>, B<-W> or B<-X>) that
1068 control warnings is used and neither C<$^W> nor the C<warnings> pragma
1069 are used, then default warnings will be enabled and optional warnings
1071 This means that legacy code that doesn't attempt to control the warnings
1072 will work unchanged.
1076 The B<-w> flag just sets the global C<$^W> variable as in 5.005. This
1077 means that any legacy code that currently relies on manipulating C<$^W>
1078 to control warning behavior will still work as is.
1082 Apart from now being a boolean, the C<$^W> variable operates in exactly
1083 the same horrible uncontrolled global way, except that it cannot
1084 disable/enable default warnings.
1088 If a piece of code is under the control of the C<warnings> pragma,
1089 both the C<$^W> variable and the B<-w> flag will be ignored for the
1090 scope of the lexical warning.
1094 The only way to override a lexical warnings setting is with the B<-W>
1095 or B<-X> command line flags.
1099 The combined effect of 3 & 4 is that it will allow code which uses
1100 the C<warnings> pragma to control the warning behavior of $^W-type
1101 code (using a C<local $^W=0>) if it really wants to, but not vice-versa.
1103 =head2 Category Hierarchy
1104 X<warning, categories>
1106 A hierarchy of "categories" have been defined to allow groups of warnings
1107 to be enabled/disabled in isolation.
1109 The current hierarchy is:
1111 =for warnings.pl tree-goes-here
1113 Just like the "strict" pragma any of these categories can be combined
1115 use warnings qw(void redefine);
1116 no warnings qw(io syntax untie);
1118 Also like the "strict" pragma, if there is more than one instance of the
1119 C<warnings> pragma in a given scope the cumulative effect is additive.
1121 use warnings qw(void); # only "void" warnings enabled
1123 use warnings qw(io); # only "void" & "io" warnings enabled
1125 no warnings qw(void); # only "io" warnings enabled
1127 To determine which category a specific warning has been assigned to see
1130 Note: Before Perl 5.8.0, the lexical warnings category "deprecated" was a
1131 sub-category of the "syntax" category. It is now a top-level category
1134 Note: Before 5.21.0, the "missing" lexical warnings category was
1135 internally defined to be the same as the "uninitialized" category. It
1136 is now a top-level category in its own right.
1138 =head2 Fatal Warnings
1141 The presence of the word "FATAL" in the category list will escalate
1142 warnings in those categories into fatal errors in that lexical scope.
1144 B<NOTE:> FATAL warnings should be used with care, particularly
1145 C<< FATAL => 'all' >>.
1147 Libraries using L<warnings::warn|/FUNCTIONS> for custom warning categories
1148 generally don't expect L<warnings::warn|/FUNCTIONS> to be fatal and can wind up
1149 in an unexpected state as a result. For XS modules issuing categorized
1150 warnings, such unanticipated exceptions could also expose memory leak bugs.
1152 Moreover, the Perl interpreter itself has had serious bugs involving
1153 fatalized warnings. For a summary of resolved and unresolved problems as
1154 of January 2015, please see
1155 L<this perl5-porters post|http://www.nntp.perl.org/group/perl.perl5.porters/2015/01/msg225235.html>.
1157 While some developers find fatalizing some warnings to be a useful
1158 defensive programming technique, using C<< FATAL => 'all' >> to fatalize
1159 all possible warning categories -- including custom ones -- is particularly
1160 risky. Therefore, the use of C<< FATAL => 'all' >> is
1161 L<discouraged|perlpolicy/discouraged>.
1163 The L<strictures|strictures/VERSION-2> module on CPAN offers one example of
1164 a warnings subset that the module's authors believe is relatively safe to
1167 B<NOTE:> users of FATAL warnings, especially those using
1168 C<< FATAL => 'all' >>, should be fully aware that they are risking future
1169 portability of their programs by doing so. Perl makes absolutely no
1170 commitments to not introduce new warnings or warnings categories in the
1171 future; indeed, we explicitly reserve the right to do so. Code that may
1172 not warn now may warn in a future release of Perl if the Perl5 development
1173 team deems it in the best interests of the community to do so. Should code
1174 using FATAL warnings break due to the introduction of a new warning we will
1175 NOT consider it an incompatible change. Users of FATAL warnings should
1176 take special caution during upgrades to check to see if their code triggers
1177 any new warnings and should pay particular attention to the fine print of
1178 the documentation of the features they use to ensure they do not exploit
1179 features that are documented as risky, deprecated, or unspecified, or where
1180 the documentation says "so don't do that", or anything with the same sense
1181 and spirit. Use of such features in combination with FATAL warnings is
1182 ENTIRELY AT THE USER'S RISK.
1184 The following documentation describes how to use FATAL warnings but the
1185 perl5 porters strongly recommend that you understand the risks before doing
1186 so, especially for library code intended for use by others, as there is no
1187 way for downstream users to change the choice of fatal categories.
1189 In the code below, the use of C<time>, C<length>
1190 and C<join> can all produce a C<"Useless use of xxx in void context">
1198 use warnings FATAL => qw(void);
1206 When run it produces this output
1208 Useless use of time in void context at fatal line 3.
1209 Useless use of length in void context at fatal line 7.
1211 The scope where C<length> is used has escalated the C<void> warnings
1212 category into a fatal error, so the program terminates immediately when it
1213 encounters the warning.
1215 To explicitly turn off a "FATAL" warning you just disable the warning
1216 it is associated with. So, for example, to disable the "void" warning
1217 in the example above, either of these will do the trick:
1219 no warnings qw(void);
1220 no warnings FATAL => qw(void);
1222 If you want to downgrade a warning that has been escalated into a fatal
1223 error back to a normal warning, you can use the "NONFATAL" keyword. For
1224 example, the code below will promote all warnings into fatal errors,
1225 except for those in the "syntax" category.
1227 use warnings FATAL => 'all', NONFATAL => 'syntax';
1229 As of Perl 5.20, instead of C<< use warnings FATAL => 'all'; >> you can
1232 use v5.20; # Perl 5.20 or greater is required for the following
1233 use warnings 'FATAL'; # short form of "use warnings FATAL => 'all';"
1235 If you want your program to be compatible with versions of Perl before
1236 5.20, you must use C<< use warnings FATAL => 'all'; >> instead. (In
1237 previous versions of Perl, the behavior of the statements
1238 C<< use warnings 'FATAL'; >>, C<< use warnings 'NONFATAL'; >> and
1239 C<< no warnings 'FATAL'; >> was unspecified; they did not behave as if
1240 they included the C<< => 'all' >> portion. As of 5.20, they do.)
1242 =head2 Reporting Warnings from a Module
1243 X<warning, reporting> X<warning, registering>
1245 The C<warnings> pragma provides a number of functions that are useful for
1246 module authors. These are used when you want to report a module-specific
1247 warning to a calling module has enabled warnings via the C<warnings>
1250 Consider the module C<MyMod::Abc> below.
1254 use warnings::register;
1258 if ($path !~ m#^/#) {
1259 warnings::warn("changing relative path to /var/abc")
1260 if warnings::enabled();
1261 $path = "/var/abc/$path";
1267 The call to C<warnings::register> will create a new warnings category
1268 called "MyMod::Abc", i.e. the new category name matches the current
1269 package name. The C<open> function in the module will display a warning
1270 message if it gets given a relative path as a parameter. This warnings
1271 will only be displayed if the code that uses C<MyMod::Abc> has actually
1272 enabled them with the C<warnings> pragma like below.
1275 use warnings 'MyMod::Abc';
1277 abc::open("../fred.txt");
1279 It is also possible to test whether the pre-defined warnings categories are
1280 set in the calling module with the C<warnings::enabled> function. Consider
1281 this snippet of code:
1286 if (warnings::enabled("deprecated")) {
1287 warnings::warn("deprecated",
1288 "open is deprecated, use new instead");
1297 The function C<open> has been deprecated, so code has been included to
1298 display a warning message whenever the calling module has (at least) the
1299 "deprecated" warnings category enabled. Something like this, say.
1301 use warnings 'deprecated';
1304 MyMod::Abc::open($filename);
1306 Either the C<warnings::warn> or C<warnings::warnif> function should be
1307 used to actually display the warnings message. This is because they can
1308 make use of the feature that allows warnings to be escalated into fatal
1309 errors. So in this case
1312 use warnings FATAL => 'MyMod::Abc';
1314 MyMod::Abc::open('../fred.txt');
1316 the C<warnings::warnif> function will detect this and die after
1317 displaying the warning message.
1319 The three warnings functions, C<warnings::warn>, C<warnings::warnif>
1320 and C<warnings::enabled> can optionally take an object reference in place
1321 of a category name. In this case the functions will use the class name
1322 of the object as the warnings category.
1324 Consider this example:
1329 use warnings::register;
1342 if ($value % 2 && warnings::enabled($self))
1343 { warnings::warn($self, "Odd numbers are unsafe") }
1350 $self->check($value);
1358 use warnings::register;
1360 our @ISA = qw( Original );
1370 The code below makes use of both modules, but it only enables warnings from
1375 use warnings 'Derived';
1376 my $x = Original->new();
1378 my $y = Derived->new();
1381 When this code is run only the C<Derived> object, C<$y>, will generate
1384 Odd numbers are unsafe at main.pl line 7
1386 Notice also that the warning is reported at the line where the object is first
1389 When registering new categories of warning, you can supply more names to
1390 warnings::register like this:
1393 use warnings::register qw(format precision);
1397 warnings::warnif('MyModule::format', '...');
1401 Note: The functions with names ending in C<_at_level> were added in Perl
1406 =item use warnings::register
1408 Creates a new warnings category with the same name as the package where
1409 the call to the pragma is used.
1411 =item warnings::enabled()
1413 Use the warnings category with the same name as the current package.
1415 Return TRUE if that warnings category is enabled in the calling module.
1416 Otherwise returns FALSE.
1418 =item warnings::enabled($category)
1420 Return TRUE if the warnings category, C<$category>, is enabled in the
1422 Otherwise returns FALSE.
1424 =item warnings::enabled($object)
1426 Use the name of the class for the object reference, C<$object>, as the
1429 Return TRUE if that warnings category is enabled in the first scope
1430 where the object is used.
1431 Otherwise returns FALSE.
1433 =item warnings::enabled_at_level($category, $level)
1435 Like C<warnings::enabled>, but $level specifies the exact call frame, 0
1436 being the immediate caller.
1438 =item warnings::fatal_enabled()
1440 Return TRUE if the warnings category with the same name as the current
1441 package has been set to FATAL in the calling module.
1442 Otherwise returns FALSE.
1444 =item warnings::fatal_enabled($category)
1446 Return TRUE if the warnings category C<$category> has been set to FATAL in
1448 Otherwise returns FALSE.
1450 =item warnings::fatal_enabled($object)
1452 Use the name of the class for the object reference, C<$object>, as the
1455 Return TRUE if that warnings category has been set to FATAL in the first
1456 scope where the object is used.
1457 Otherwise returns FALSE.
1459 =item warnings::fatal_enabled_at_level($category, $level)
1461 Like C<warnings::fatal_enabled>, but $level specifies the exact call frame,
1462 0 being the immediate caller.
1464 =item warnings::warn($message)
1466 Print C<$message> to STDERR.
1468 Use the warnings category with the same name as the current package.
1470 If that warnings category has been set to "FATAL" in the calling module
1471 then die. Otherwise return.
1473 =item warnings::warn($category, $message)
1475 Print C<$message> to STDERR.
1477 If the warnings category, C<$category>, has been set to "FATAL" in the
1478 calling module then die. Otherwise return.
1480 =item warnings::warn($object, $message)
1482 Print C<$message> to STDERR.
1484 Use the name of the class for the object reference, C<$object>, as the
1487 If that warnings category has been set to "FATAL" in the scope where C<$object>
1488 is first used then die. Otherwise return.
1490 =item warnings::warn_at_level($category, $level, $message)
1492 Like C<warnings::warn>, but $level specifies the exact call frame,
1493 0 being the immediate caller.
1495 =item warnings::warnif($message)
1499 if (warnings::enabled())
1500 { warnings::warn($message) }
1502 =item warnings::warnif($category, $message)
1506 if (warnings::enabled($category))
1507 { warnings::warn($category, $message) }
1509 =item warnings::warnif($object, $message)
1513 if (warnings::enabled($object))
1514 { warnings::warn($object, $message) }
1516 =item warnings::warnif_at_level($category, $level, $message)
1518 Like C<warnings::warnif>, but $level specifies the exact call frame,
1519 0 being the immediate caller.
1521 =item warnings::register_categories(@names)
1523 This registers warning categories for the given names and is primarily for
1524 use by the warnings::register pragma.
1528 See also L<perlmodlib/Pragmatic Modules> and L<perldiag>.