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 ],
116 'missing' => [ 5.021, DEFAULT_OFF],
117 'redundant' => [ 5.021, DEFAULT_OFF],
118 'locale' => [ 5.021, DEFAULT_ON],
119 'shadow' => [ 5.027, DEFAULT_OFF],
121 #'default' => [ 5.008, DEFAULT_ON ],
138 foreach $k (sort keys %$tre) {
140 die "duplicate key $k\n" if defined $list{$k} ;
141 die "Value associated with key '$k' is not an ARRAY reference"
142 if !ref $v || ref $v ne 'ARRAY' ;
144 my ($ver, $rest) = @{ $v } ;
145 push @{ $v_list{$ver} }, $k;
148 { valueWalk ($rest) }
157 foreach my $ver ( sort { $a <=> $b } keys %v_list ) {
158 foreach my $name (@{ $v_list{$ver} } ) {
159 $ValueToName{ $index } = [ uc $name, $ver ] ;
160 $NameToValue{ uc $name } = $index ++ ;
167 ###########################################################################
175 foreach $k (sort keys %$tre) {
177 die "duplicate key $k\n" if defined $list{$k} ;
178 die "Can't find key '$k'"
179 if ! defined $NameToValue{uc $k} ;
180 push @{ $list{$k} }, $NameToValue{uc $k} ;
181 die "Value associated with key '$k' is not an ARRAY reference"
182 if !ref $v || ref $v ne 'ARRAY' ;
184 my ($ver, $rest) = @{ $v } ;
186 { push (@{ $list{$k} }, walk ($rest)) }
187 elsif ($rest == DEFAULT_ON)
188 { push @def, $NameToValue{uc $k} }
190 push @list, @{ $list{$k} } ;
196 ###########################################################################
203 for my $i (1 .. @a - 1) {
205 if $a[$i] == $a[$i - 1] + 1
206 && ($i >= @a - 1 || $a[$i] + 1 == $a[$i + 1] );
208 $out[-1] = $a[-1] if $out[-1] eq "..";
210 my $out = join(",",@out);
212 $out =~ s/,(\.\.,)+/../g ;
216 ###########################################################################
223 my $max = (sort {$a <=> $b} map { length $_ } keys %$tre)[-1] ;
224 my @keys = sort keys %$tre ;
228 while ($k = shift @keys) {
230 die "Value associated with key '$k' is not an ARRAY reference"
231 if !ref $v || ref $v ne 'ARRAY' ;
235 $rv .= $prefix . "|\n" ;
236 $rv .= $prefix . "+- $k" ;
237 $offset = ' ' x ($max + 4) ;
240 $rv .= $prefix . "$k" ;
241 $offset = ' ' x ($max + 1) ;
244 my ($ver, $rest) = @{ $v } ;
247 my $bar = @keys ? "|" : " ";
248 $rv .= " -" . "-" x ($max - length $k ) . "+\n" ;
249 $rv .= warningsTree ($rest, $prefix . $bar . $offset )
258 ###########################################################################
262 my ($f, $max, @a) = @_ ;
263 my $mask = "\x00" x $max ;
267 vec($mask, $_, 1) = 1 ;
270 foreach (unpack("C*", $mask)) {
272 $string .= '\x' . sprintf("%2.2x", $_)
275 $string .= '\\' . sprintf("%o", $_)
284 return mkHexOct("x", $max, @a);
290 return mkHexOct("o", $max, @a);
293 ###########################################################################
295 if (@ARGV && $ARGV[0] eq "tree")
297 print warningsTree($tree, " ") ;
301 my ($warn, $pm) = map {
302 open_new($_, '>', { by => 'regen/warnings.pl' });
303 } 'warnings.h', 'lib/warnings.pm';
305 my ($index, $warn_size);
308 # generate warnings.h
312 #define Off(x) ((x) / 8)
313 #define Bit(x) (1 << ((x) % 8))
314 #define IsSet(a, x) ((a)[Off(x)] & Bit(x))
317 #define G_WARN_OFF 0 /* $^W == 0 */
318 #define G_WARN_ON 1 /* -w flag and $^W != 0 */
319 #define G_WARN_ALL_ON 2 /* -W flag */
320 #define G_WARN_ALL_OFF 4 /* -X flag */
321 #define G_WARN_ONCE 8 /* set if 'once' ever enabled */
322 #define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF)
324 #define pWARN_STD NULL
325 #define pWARN_ALL (((STRLEN*)0)+1) /* use warnings 'all' */
326 #define pWARN_NONE (((STRLEN*)0)+2) /* no warnings 'all' */
328 #define specialWARN(x) ((x) == pWARN_STD || (x) == pWARN_ALL || \
331 /* if PL_warnhook is set to this value, then warnings die */
332 #define PERL_WARNHOOK_FATAL (&PL_sv_placeholder)
338 $index = orderValues();
340 die <<EOM if $index > 255 ;
341 Too many warnings categories -- max is 255
342 rewrite packWARN* & unpackWARN* macros
346 for (my $i = $index; $i & 3; $i++) {
347 push @{$list{all}}, $i;
351 $warn_size = int($index / 8) + ($index % 8 != 0) ;
355 foreach $k (sort { $a <=> $b } keys %ValueToName) {
356 my ($name, $version) = @{ $ValueToName{$k} };
357 print $warn "\n/* Warnings Categories added in Perl $version */\n\n"
358 if $last_ver != $version ;
360 print $warn tab(6, "#define WARN_$name"), " $k\n" ;
361 $last_ver = $version ;
365 print $warn tab(6, '#define WARNsize'), " $warn_size\n" ;
366 print $warn tab(6, '#define WARN_ALLstring'), ' "', ('\125' x $warn_size) , "\"\n" ;
367 print $warn tab(6, '#define WARN_NONEstring'), ' "', ('\0' x $warn_size) , "\"\n" ;
371 #define isLEXWARN_on \
372 cBOOL(PL_curcop && PL_curcop->cop_warnings != pWARN_STD)
373 #define isLEXWARN_off \
374 cBOOL(!PL_curcop || PL_curcop->cop_warnings == pWARN_STD)
375 #define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
376 #define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)))
377 #define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1))
379 #define DUP_WARNINGS(p) \
380 (specialWARN(p) ? (STRLEN*)(p) \
381 : (STRLEN*)CopyD(p, PerlMemShared_malloc(sizeof(*p)+*p), sizeof(*p)+*p, \
386 =head1 Warning and Dieing
388 =for apidoc Am|bool|ckWARN|U32 w
390 Returns a boolean as to whether or not warnings are enabled for the warning
391 category C<w>. If the category is by default enabled even if not within the
392 scope of S<C<use warnings>>, instead use the L</ckWARN_d> macro.
394 =for apidoc Am|bool|ckWARN_d|U32 w
396 Like C<L</ckWARN>>, but for use if and only if the warning category is by
397 default enabled even if not within the scope of S<C<use warnings>>.
399 =for apidoc Am|bool|ckWARN2|U32 w1|U32 w2
401 Like C<L</ckWARN>>, but takes two warnings categories as input, and returns
402 TRUE if either is enabled. If either category is by default enabled even if
403 not within the scope of S<C<use warnings>>, instead use the L</ckWARN2_d>
404 macro. The categories must be completely independent, one may not be
405 subclassed from the other.
407 =for apidoc Am|bool|ckWARN2_d|U32 w1|U32 w2
409 Like C<L</ckWARN2>>, but for use if and only if either warning category is by
410 default enabled even if not within the scope of S<C<use warnings>>.
412 =for apidoc Am|bool|ckWARN3|U32 w1|U32 w2|U32 w3
414 Like C<L</ckWARN2>>, but takes three warnings categories as input, and returns
415 TRUE if any is enabled. If any of the categories is by default enabled even
416 if not within the scope of S<C<use warnings>>, instead use the L</ckWARN3_d>
417 macro. The categories must be completely independent, one may not be
418 subclassed from any other.
420 =for apidoc Am|bool|ckWARN3_d|U32 w1|U32 w2|U32 w3
422 Like C<L</ckWARN3>>, but for use if and only if any of the warning categories
423 is by default enabled even if not within the scope of S<C<use warnings>>.
425 =for apidoc Am|bool|ckWARN4|U32 w1|U32 w2|U32 w3|U32 w4
427 Like C<L</ckWARN3>>, but takes four warnings categories as input, and returns
428 TRUE if any is enabled. If any of the categories is by default enabled even
429 if not within the scope of S<C<use warnings>>, instead use the L</ckWARN4_d>
430 macro. The categories must be completely independent, one may not be
431 subclassed from any other.
433 =for apidoc Am|bool|ckWARN4_d|U32 w1|U32 w2|U32 w3|U32 w4
435 Like C<L</ckWARN4>>, but for use if and only if any of the warning categories
436 is by default enabled even if not within the scope of S<C<use warnings>>.
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)))))))))
483 /* end of file warnings.h */
486 read_only_bottom_close_and_rename($warn);
490 last if /^VERSION$/ ;
494 print $pm qq(our \$VERSION = "$::VERSION";\n);
497 last if /^KEYWORDS$/ ;
502 print $pm "our %Offsets = (" ;
503 foreach my $k (sort { $a <=> $b } keys %ValueToName) {
504 my ($name, $version) = @{ $ValueToName{$k} };
507 if ( $last_ver != $version ) {
509 print $pm tab(6, " # Warnings Categories added in Perl $version");
512 print $pm tab(6, " '$name'"), "=> $k,\n" ;
513 $last_ver = $version;
518 print $pm "our %Bits = (\n" ;
519 foreach my $k (sort keys %list) {
522 my @list = sort { $a <=> $b } @$v ;
524 print $pm tab(6, " '$k'"), '=> "',
525 mkHex($warn_size, map $_ * 2 , @list),
526 '", # [', mkRange(@list), "]\n" ;
531 print $pm "our %DeadBits = (\n" ;
532 foreach my $k (sort keys %list) {
535 my @list = sort { $a <=> $b } @$v ;
537 print $pm tab(6, " '$k'"), '=> "',
538 mkHex($warn_size, map $_ * 2 + 1 , @list),
539 '", # [', mkRange(@list), "]\n" ;
543 print $pm "# These are used by various things, including our own tests\n";
544 print $pm tab(6, 'our $NONE'), '= "', ('\0' x $warn_size) , "\";\n" ;
545 print $pm tab(6, 'our $DEFAULT'), '= "', mkHex($warn_size, map $_ * 2, @def),
546 '", # [', mkRange(sort { $a <=> $b } @def), "]\n" ;
547 print $pm tab(6, 'our $LAST_BIT'), '= ' . "$index ;\n" ;
548 print $pm tab(6, 'our $BYTES'), '= ' . "$warn_size ;\n" ;
550 if ($_ eq "=for warnings.pl tree-goes-here\n") {
551 print $pm warningsTree($tree, " ");
557 read_only_bottom_close_and_rename($pm);
564 # Verify that we're called correctly so that warnings will work.
565 # Can't use Carp, since Carp uses us!
566 # String regexps because constant folding = smaller optree = less memory vs regexp literal
567 # see also strict.pm.
568 die sprintf "Incorrect use of pragma '%s' at %s line %d.\n", __PACKAGE__, +(caller)[1,2]
569 if __FILE__ !~ ( '(?x) \b '.__PACKAGE__.' \.pmc? \z' )
570 && __FILE__ =~ ( '(?x) \b (?i:'.__PACKAGE__.') \.pmc? \z' );
576 require Carp; # this initializes %CarpInternal
577 local $Carp::CarpInternal{'warnings'};
578 delete $Carp::CarpInternal{'warnings'};
584 my $want_len = ($LAST_BIT + 7) >> 3;
585 my $len = length($bits);
586 if ($len != $want_len) {
588 $bits = "\x00" x $want_len;
589 } elsif ($len > $want_len) {
590 substr $bits, $want_len, $len-$want_len, "";
592 my $a = vec($bits, $Offsets{all} >> 1, 2);
595 $bits .= chr($a) x ($want_len - $len);
607 $mask = _expand_bits($mask);
608 foreach my $word ( @_ ) {
609 if ($word eq 'FATAL') {
613 elsif ($word eq 'NONFATAL') {
617 elsif ($catmask = $Bits{$word}) {
619 $mask |= $DeadBits{$word} if $fatal ;
620 $mask = ~(~$mask | $DeadBits{$word}) if $no_fatal ;
623 { Croaker("Unknown warnings category '$word'")}
631 # called from B::Deparse.pm
632 push @_, 'all' unless @_ ;
633 return _bits("", @_) ;
640 my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
642 # append 'all' when implied (empty import list or after a lone
643 # "FATAL" or "NONFATAL")
645 if !@_ || (@_==1 && ($_[0] eq 'FATAL' || $_[0] eq 'NONFATAL'));
647 ${^WARNING_BITS} = _bits($mask, @_);
655 my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
657 # append 'all' when implied (empty import list or after a lone "FATAL")
658 push @_, 'all' if !@_ || @_==1 && $_[0] eq 'FATAL';
660 $mask = _expand_bits($mask);
661 foreach my $word ( @_ ) {
662 if ($word eq 'FATAL') {
665 elsif ($catmask = $Bits{$word}) {
666 $mask = ~(~$mask | $catmask | $DeadBits{$word});
669 { Croaker("Unknown warnings category '$word'")}
672 ${^WARNING_BITS} = $mask ;
675 my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
678 sub MESSAGE () { 4 };
688 my $has_message = $wanted & MESSAGE;
689 my $has_level = $wanted & LEVEL ;
692 if (@_ != ($has_message ? 3 : 2)) {
693 my $sub = (caller 1)[3];
694 my $syntax = $has_message
695 ? "category, level, 'message'"
697 Croaker("Usage: $sub($syntax)");
700 elsif (not @_ == 1 || @_ == ($has_message ? 2 : 0)) {
701 my $sub = (caller 1)[3];
702 my $syntax = $has_message ? "[category,] 'message'" : '[category]';
703 Croaker("Usage: $sub($syntax)");
706 my $message = pop if $has_message;
709 # check the category supplied.
711 if (my $type = ref $category) {
712 Croaker("not an object")
713 if exists $builtin_type{$type};
717 $offset = $Offsets{$category};
718 Croaker("Unknown warnings category '$category'")
719 unless defined $offset;
722 $category = (caller(1))[0] ;
723 $offset = $Offsets{$category};
724 Croaker("package '$category' not registered for warnings")
725 unless defined $offset ;
733 while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
734 last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
742 $i = _error_loc(); # see where Carp will allocate the error
745 # Default to 0 if caller returns nothing. Default to $DEFAULT if it
746 # explicitly returns undef.
747 my(@callers_bitmask) = (caller($i))[9] ;
748 my $callers_bitmask =
749 @callers_bitmask ? $callers_bitmask[0] // $DEFAULT : 0 ;
750 length($callers_bitmask) > ($offset >> 3) or $offset = $Offsets{all};
753 foreach my $type (FATAL, NORMAL) {
754 next unless $wanted & $type;
756 push @results, vec($callers_bitmask, $offset + $type - 1, 1);
759 # &enabled and &fatal_enabled
760 return $results[0] unless $has_message;
762 # &warnif, and the category is neither enabled as warning nor as fatal
763 return if ($wanted & (NORMAL | FATAL | MESSAGE))
764 == (NORMAL | FATAL | MESSAGE)
765 && !($results[0] || $results[1]);
767 # If we have an explicit level, bypass Carp.
768 if ($has_level and @callers_bitmask) {
769 # logic copied from util.c:mess_sv
770 my $stuff = " at " . join " line ", (caller $i)[1,2];
771 $stuff .= sprintf ", <%s> %s %d",
773 ($/ eq "\n" ? "line" : "chunk"), $.
774 if $. && ${^LAST_FH};
775 die "$message$stuff.\n" if $results[0];
776 return warn "$message$stuff.\n";
780 Carp::croak($message) if $results[0];
781 # will always get here for &warn. will only get here for &warnif if the
782 # category is enabled
783 Carp::carp($message);
791 vec($mask, $bit, 1) = 1;
795 sub register_categories
799 for my $name (@names) {
800 if (! defined $Bits{$name}) {
801 $Offsets{$name} = $LAST_BIT;
802 $Bits{$name} = _mkMask($LAST_BIT++);
803 $DeadBits{$name} = _mkMask($LAST_BIT++);
804 if (length($Bits{$name}) > length($Bits{all})) {
805 $Bits{all} .= "\x55";
806 $DeadBits{all} .= "\xaa";
814 goto &Carp::short_error_loc; # don't introduce another stack frame
819 return __chk(NORMAL, @_);
824 return __chk(FATAL, @_);
829 return __chk(FATAL | MESSAGE, @_);
834 return __chk(NORMAL | FATAL | MESSAGE, @_);
839 return __chk(NORMAL | LEVEL, @_);
842 sub fatal_enabled_at_level
844 return __chk(FATAL | LEVEL, @_);
849 return __chk(FATAL | MESSAGE | LEVEL, @_);
854 return __chk(NORMAL | FATAL | MESSAGE | LEVEL, @_);
857 # These are not part of any public interface, so we can delete them to save
859 delete @warnings::{qw(NORMAL FATAL MESSAGE LEVEL)};
865 warnings - Perl pragma to control optional warnings
875 use warnings::register;
876 if (warnings::enabled()) {
877 warnings::warn("some warning");
880 if (warnings::enabled("void")) {
881 warnings::warn("void", "some warning");
884 if (warnings::enabled($object)) {
885 warnings::warn($object, "some warning");
888 warnings::warnif("some warning");
889 warnings::warnif("void", "some warning");
890 warnings::warnif($object, "some warning");
894 The C<warnings> pragma gives control over which warnings are enabled in
895 which parts of a Perl program. It's a more flexible alternative for
896 both the command line flag B<-w> and the equivalent Perl variable,
899 This pragma works just like the C<strict> pragma.
900 This means that the scope of the warning pragma is limited to the
901 enclosing block. It also means that the pragma setting will not
902 leak across files (via C<use>, C<require> or C<do>). This allows
903 authors to independently define the degree of warning checks that will
904 be applied to their module.
906 By default, optional warnings are disabled, so any legacy code that
907 doesn't attempt to control the warnings will work unchanged.
909 All warnings are enabled in a block by either of these:
914 Similarly all warnings are disabled in a block by either of these:
919 For example, consider the code below:
929 The code in the enclosing block has warnings enabled, but the inner
930 block has them disabled. In this case that means the assignment to the
931 scalar C<$c> will trip the C<"Scalar value @a[0] better written as $a[0]">
932 warning, but the assignment to the scalar C<$b> will not.
934 =head2 Default Warnings and Optional Warnings
936 Before the introduction of lexical warnings, Perl had two classes of
937 warnings: mandatory and optional.
939 As its name suggests, if your code tripped a mandatory warning, you
940 would get a warning whether you wanted it or not.
941 For example, the code below would always produce an C<"isn't numeric">
942 warning about the "2:".
946 With the introduction of lexical warnings, mandatory warnings now become
947 I<default> warnings. The difference is that although the previously
948 mandatory warnings are still enabled by default, they can then be
949 subsequently enabled or disabled with the lexical warning pragma. For
950 example, in the code below, an C<"isn't numeric"> warning will only
951 be reported for the C<$a> variable.
957 Note that neither the B<-w> flag or the C<$^W> can be used to
958 disable/enable default warnings. They are still mandatory in this case.
960 =head2 What's wrong with B<-w> and C<$^W>
962 Although very useful, the big problem with using B<-w> on the command
963 line to enable warnings is that it is all or nothing. Take the typical
964 scenario when you are writing a Perl program. Parts of the code you
965 will write yourself, but it's very likely that you will make use of
966 pre-written Perl modules. If you use the B<-w> flag in this case, you
967 end up enabling warnings in pieces of code that you haven't written.
969 Similarly, using C<$^W> to either disable or enable blocks of code is
970 fundamentally flawed. For a start, say you want to disable warnings in
971 a block of code. You might expect this to be enough to do the trick:
979 When this code is run with the B<-w> flag, a warning will be produced
980 for the C<$a> line: C<"Reversed += operator">.
982 The problem is that Perl has both compile-time and run-time warnings. To
983 disable compile-time warnings you need to rewrite the code like this:
991 The other big problem with C<$^W> is the way you can inadvertently
992 change the warning setting in unexpected places in your code. For example,
993 when the code below is run (without the B<-w> flag), the second call
994 to C<doit> will trip a C<"Use of uninitialized value"> warning, whereas
1009 This is a side-effect of C<$^W> being dynamically scoped.
1011 Lexical warnings get around these limitations by allowing finer control
1012 over where warnings can or can't be tripped.
1014 =head2 Controlling Warnings from the Command Line
1016 There are three Command Line flags that can be used to control when
1017 warnings are (or aren't) produced:
1024 This is the existing flag. If the lexical warnings pragma is B<not>
1025 used in any of you code, or any of the modules that you use, this flag
1026 will enable warnings everywhere. See L<Backward Compatibility> for
1027 details of how this flag interacts with lexical warnings.
1032 If the B<-W> flag is used on the command line, it will enable all warnings
1033 throughout the program regardless of whether warnings were disabled
1034 locally using C<no warnings> or C<$^W =0>.
1035 This includes all files that get
1036 included via C<use>, C<require> or C<do>.
1037 Think of it as the Perl equivalent of the "lint" command.
1042 Does the exact opposite to the B<-W> flag, i.e. it disables all warnings.
1046 =head2 Backward Compatibility
1048 If you are used to working with a version of Perl prior to the
1049 introduction of lexically scoped warnings, or have code that uses both
1050 lexical warnings and C<$^W>, this section will describe how they interact.
1052 How Lexical Warnings interact with B<-w>/C<$^W>:
1058 If none of the three command line flags (B<-w>, B<-W> or B<-X>) that
1059 control warnings is used and neither C<$^W> nor the C<warnings> pragma
1060 are used, then default warnings will be enabled and optional warnings
1062 This means that legacy code that doesn't attempt to control the warnings
1063 will work unchanged.
1067 The B<-w> flag just sets the global C<$^W> variable as in 5.005. This
1068 means that any legacy code that currently relies on manipulating C<$^W>
1069 to control warning behavior will still work as is.
1073 Apart from now being a boolean, the C<$^W> variable operates in exactly
1074 the same horrible uncontrolled global way, except that it cannot
1075 disable/enable default warnings.
1079 If a piece of code is under the control of the C<warnings> pragma,
1080 both the C<$^W> variable and the B<-w> flag will be ignored for the
1081 scope of the lexical warning.
1085 The only way to override a lexical warnings setting is with the B<-W>
1086 or B<-X> command line flags.
1090 The combined effect of 3 & 4 is that it will allow code which uses
1091 the C<warnings> pragma to control the warning behavior of $^W-type
1092 code (using a C<local $^W=0>) if it really wants to, but not vice-versa.
1094 =head2 Category Hierarchy
1095 X<warning, categories>
1097 A hierarchy of "categories" have been defined to allow groups of warnings
1098 to be enabled/disabled in isolation.
1100 The current hierarchy is:
1102 =for warnings.pl tree-goes-here
1104 Just like the "strict" pragma any of these categories can be combined
1106 use warnings qw(void redefine);
1107 no warnings qw(io syntax untie);
1109 Also like the "strict" pragma, if there is more than one instance of the
1110 C<warnings> pragma in a given scope the cumulative effect is additive.
1112 use warnings qw(void); # only "void" warnings enabled
1114 use warnings qw(io); # only "void" & "io" warnings enabled
1116 no warnings qw(void); # only "io" warnings enabled
1118 To determine which category a specific warning has been assigned to see
1121 Note: Before Perl 5.8.0, the lexical warnings category "deprecated" was a
1122 sub-category of the "syntax" category. It is now a top-level category
1125 Note: Before 5.21.0, the "missing" lexical warnings category was
1126 internally defined to be the same as the "uninitialized" category. It
1127 is now a top-level category in its own right.
1129 =head2 Fatal Warnings
1132 The presence of the word "FATAL" in the category list will escalate
1133 warnings in those categories into fatal errors in that lexical scope.
1135 B<NOTE:> FATAL warnings should be used with care, particularly
1136 C<< FATAL => 'all' >>.
1138 Libraries using L<warnings::warn|/FUNCTIONS> for custom warning categories
1139 generally don't expect L<warnings::warn|/FUNCTIONS> to be fatal and can wind up
1140 in an unexpected state as a result. For XS modules issuing categorized
1141 warnings, such unanticipated exceptions could also expose memory leak bugs.
1143 Moreover, the Perl interpreter itself has had serious bugs involving
1144 fatalized warnings. For a summary of resolved and unresolved problems as
1145 of January 2015, please see
1146 L<this perl5-porters post|http://www.nntp.perl.org/group/perl.perl5.porters/2015/01/msg225235.html>.
1148 While some developers find fatalizing some warnings to be a useful
1149 defensive programming technique, using C<< FATAL => 'all' >> to fatalize
1150 all possible warning categories -- including custom ones -- is particularly
1151 risky. Therefore, the use of C<< FATAL => 'all' >> is
1152 L<discouraged|perlpolicy/discouraged>.
1154 The L<strictures|strictures/VERSION-2> module on CPAN offers one example of
1155 a warnings subset that the module's authors believe is relatively safe to
1158 B<NOTE:> users of FATAL warnings, especially those using
1159 C<< FATAL => 'all' >>, should be fully aware that they are risking future
1160 portability of their programs by doing so. Perl makes absolutely no
1161 commitments to not introduce new warnings or warnings categories in the
1162 future; indeed, we explicitly reserve the right to do so. Code that may
1163 not warn now may warn in a future release of Perl if the Perl5 development
1164 team deems it in the best interests of the community to do so. Should code
1165 using FATAL warnings break due to the introduction of a new warning we will
1166 NOT consider it an incompatible change. Users of FATAL warnings should
1167 take special caution during upgrades to check to see if their code triggers
1168 any new warnings and should pay particular attention to the fine print of
1169 the documentation of the features they use to ensure they do not exploit
1170 features that are documented as risky, deprecated, or unspecified, or where
1171 the documentation says "so don't do that", or anything with the same sense
1172 and spirit. Use of such features in combination with FATAL warnings is
1173 ENTIRELY AT THE USER'S RISK.
1175 The following documentation describes how to use FATAL warnings but the
1176 perl5 porters strongly recommend that you understand the risks before doing
1177 so, especially for library code intended for use by others, as there is no
1178 way for downstream users to change the choice of fatal categories.
1180 In the code below, the use of C<time>, C<length>
1181 and C<join> can all produce a C<"Useless use of xxx in void context">
1189 use warnings FATAL => qw(void);
1197 When run it produces this output
1199 Useless use of time in void context at fatal line 3.
1200 Useless use of length in void context at fatal line 7.
1202 The scope where C<length> is used has escalated the C<void> warnings
1203 category into a fatal error, so the program terminates immediately when it
1204 encounters the warning.
1206 To explicitly turn off a "FATAL" warning you just disable the warning
1207 it is associated with. So, for example, to disable the "void" warning
1208 in the example above, either of these will do the trick:
1210 no warnings qw(void);
1211 no warnings FATAL => qw(void);
1213 If you want to downgrade a warning that has been escalated into a fatal
1214 error back to a normal warning, you can use the "NONFATAL" keyword. For
1215 example, the code below will promote all warnings into fatal errors,
1216 except for those in the "syntax" category.
1218 use warnings FATAL => 'all', NONFATAL => 'syntax';
1220 As of Perl 5.20, instead of C<< use warnings FATAL => 'all'; >> you can
1223 use v5.20; # Perl 5.20 or greater is required for the following
1224 use warnings 'FATAL'; # short form of "use warnings FATAL => 'all';"
1226 If you want your program to be compatible with versions of Perl before
1227 5.20, you must use C<< use warnings FATAL => 'all'; >> instead. (In
1228 previous versions of Perl, the behavior of the statements
1229 C<< use warnings 'FATAL'; >>, C<< use warnings 'NONFATAL'; >> and
1230 C<< no warnings 'FATAL'; >> was unspecified; they did not behave as if
1231 they included the C<< => 'all' >> portion. As of 5.20, they do.)
1233 =head2 Reporting Warnings from a Module
1234 X<warning, reporting> X<warning, registering>
1236 The C<warnings> pragma provides a number of functions that are useful for
1237 module authors. These are used when you want to report a module-specific
1238 warning to a calling module has enabled warnings via the C<warnings>
1241 Consider the module C<MyMod::Abc> below.
1245 use warnings::register;
1249 if ($path !~ m#^/#) {
1250 warnings::warn("changing relative path to /var/abc")
1251 if warnings::enabled();
1252 $path = "/var/abc/$path";
1258 The call to C<warnings::register> will create a new warnings category
1259 called "MyMod::Abc", i.e. the new category name matches the current
1260 package name. The C<open> function in the module will display a warning
1261 message if it gets given a relative path as a parameter. This warnings
1262 will only be displayed if the code that uses C<MyMod::Abc> has actually
1263 enabled them with the C<warnings> pragma like below.
1266 use warnings 'MyMod::Abc';
1268 abc::open("../fred.txt");
1270 It is also possible to test whether the pre-defined warnings categories are
1271 set in the calling module with the C<warnings::enabled> function. Consider
1272 this snippet of code:
1277 if (warnings::enabled("deprecated")) {
1278 warnings::warn("deprecated",
1279 "open is deprecated, use new instead");
1288 The function C<open> has been deprecated, so code has been included to
1289 display a warning message whenever the calling module has (at least) the
1290 "deprecated" warnings category enabled. Something like this, say.
1292 use warnings 'deprecated';
1295 MyMod::Abc::open($filename);
1297 Either the C<warnings::warn> or C<warnings::warnif> function should be
1298 used to actually display the warnings message. This is because they can
1299 make use of the feature that allows warnings to be escalated into fatal
1300 errors. So in this case
1303 use warnings FATAL => 'MyMod::Abc';
1305 MyMod::Abc::open('../fred.txt');
1307 the C<warnings::warnif> function will detect this and die after
1308 displaying the warning message.
1310 The three warnings functions, C<warnings::warn>, C<warnings::warnif>
1311 and C<warnings::enabled> can optionally take an object reference in place
1312 of a category name. In this case the functions will use the class name
1313 of the object as the warnings category.
1315 Consider this example:
1320 use warnings::register;
1333 if ($value % 2 && warnings::enabled($self))
1334 { warnings::warn($self, "Odd numbers are unsafe") }
1341 $self->check($value);
1349 use warnings::register;
1351 our @ISA = qw( Original );
1361 The code below makes use of both modules, but it only enables warnings from
1366 use warnings 'Derived';
1367 my $a = Original->new();
1369 my $b = Derived->new();
1372 When this code is run only the C<Derived> object, C<$b>, will generate
1375 Odd numbers are unsafe at main.pl line 7
1377 Notice also that the warning is reported at the line where the object is first
1380 When registering new categories of warning, you can supply more names to
1381 warnings::register like this:
1384 use warnings::register qw(format precision);
1388 warnings::warnif('MyModule::format', '...');
1392 Note: The functions with names ending in C<_at_level> were added in Perl
1397 =item use warnings::register
1399 Creates a new warnings category with the same name as the package where
1400 the call to the pragma is used.
1402 =item warnings::enabled()
1404 Use the warnings category with the same name as the current package.
1406 Return TRUE if that warnings category is enabled in the calling module.
1407 Otherwise returns FALSE.
1409 =item warnings::enabled($category)
1411 Return TRUE if the warnings category, C<$category>, is enabled in the
1413 Otherwise returns FALSE.
1415 =item warnings::enabled($object)
1417 Use the name of the class for the object reference, C<$object>, as the
1420 Return TRUE if that warnings category is enabled in the first scope
1421 where the object is used.
1422 Otherwise returns FALSE.
1424 =item warnings::enabled_at_level($category, $level)
1426 Like C<warnings::enabled>, but $level specifies the exact call frame, 0
1427 being the immediate caller.
1429 =item warnings::fatal_enabled()
1431 Return TRUE if the warnings category with the same name as the current
1432 package has been set to FATAL in the calling module.
1433 Otherwise returns FALSE.
1435 =item warnings::fatal_enabled($category)
1437 Return TRUE if the warnings category C<$category> has been set to FATAL in
1439 Otherwise returns FALSE.
1441 =item warnings::fatal_enabled($object)
1443 Use the name of the class for the object reference, C<$object>, as the
1446 Return TRUE if that warnings category has been set to FATAL in the first
1447 scope where the object is used.
1448 Otherwise returns FALSE.
1450 =item warnings::fatal_enabled_at_level($category, $level)
1452 Like C<warnings::fatal_enabled>, but $level specifies the exact call frame,
1453 0 being the immediate caller.
1455 =item warnings::warn($message)
1457 Print C<$message> to STDERR.
1459 Use the warnings category with the same name as the current package.
1461 If that warnings category has been set to "FATAL" in the calling module
1462 then die. Otherwise return.
1464 =item warnings::warn($category, $message)
1466 Print C<$message> to STDERR.
1468 If the warnings category, C<$category>, has been set to "FATAL" in the
1469 calling module then die. Otherwise return.
1471 =item warnings::warn($object, $message)
1473 Print C<$message> to STDERR.
1475 Use the name of the class for the object reference, C<$object>, as the
1478 If that warnings category has been set to "FATAL" in the scope where C<$object>
1479 is first used then die. Otherwise return.
1481 =item warnings::warn_at_level($category, $level, $message)
1483 Like C<warnings::warn>, but $level specifies the exact call frame,
1484 0 being the immediate caller.
1486 =item warnings::warnif($message)
1490 if (warnings::enabled())
1491 { warnings::warn($message) }
1493 =item warnings::warnif($category, $message)
1497 if (warnings::enabled($category))
1498 { warnings::warn($category, $message) }
1500 =item warnings::warnif($object, $message)
1504 if (warnings::enabled($object))
1505 { warnings::warn($object, $message) }
1507 =item warnings::warnif_at_level($category, $level, $message)
1509 Like C<warnings::warnif>, but $level specifies the exact call frame,
1510 0 being the immediate caller.
1512 =item warnings::register_categories(@names)
1514 This registers warning categories for the given names and is primarily for
1515 use by the warnings::register pragma.
1519 See also L<perlmodlib/Pragmatic Modules> and L<perldiag>.