1230557Sjimharris# -*- mode: Perl; buffer-read-only: t -*-
2230557Sjimharris# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
3230557Sjimharris# This file is built by regen/warnings.pl.
4230557Sjimharris# Any changes made here will be lost!
5230557Sjimharris
6230557Sjimharrispackage warnings;
7230557Sjimharris
8230557Sjimharrisour $VERSION = "1.65";
9230557Sjimharris
10230557Sjimharris# Verify that we're called correctly so that warnings will work.
11230557Sjimharris# Can't use Carp, since Carp uses us!
12230557Sjimharris# String regexps because constant folding = smaller optree = less memory vs regexp literal
13230557Sjimharris# see also strict.pm.
14230557Sjimharrisdie sprintf "Incorrect use of pragma '%s' at %s line %d.\n", __PACKAGE__, +(caller)[1,2]
15230557Sjimharris    if __FILE__ !~ ( '(?x) \b     '.__PACKAGE__.'  \.pmc? \z' )
16230557Sjimharris    && __FILE__ =~ ( '(?x) \b (?i:'.__PACKAGE__.') \.pmc? \z' );
17230557Sjimharris
18230557Sjimharrisour %Offsets = (
19230557Sjimharris    # Warnings Categories added in Perl 5.008
20230557Sjimharris    'all'				=> 0,
21230557Sjimharris    'closure'				=> 2,
22230557Sjimharris    'deprecated'			=> 4,
23230557Sjimharris    'exiting'				=> 6,
24230557Sjimharris    'glob'				=> 8,
25230557Sjimharris    'io'				=> 10,
26230557Sjimharris    'closed'				=> 12,
27230557Sjimharris    'exec'				=> 14,
28230557Sjimharris    'layer'				=> 16,
29230557Sjimharris    'newline'				=> 18,
30230557Sjimharris    'pipe'				=> 20,
31230557Sjimharris    'unopened'				=> 22,
32230557Sjimharris    'misc'				=> 24,
33230557Sjimharris    'numeric'				=> 26,
34230557Sjimharris    'once'				=> 28,
35230557Sjimharris    'overflow'				=> 30,
36230557Sjimharris    'pack'				=> 32,
37230557Sjimharris    'portable'				=> 34,
38230557Sjimharris    'recursion'				=> 36,
39230557Sjimharris    'redefine'				=> 38,
40230557Sjimharris    'regexp'				=> 40,
41230557Sjimharris    'severe'				=> 42,
42230557Sjimharris    'debugging'				=> 44,
43230557Sjimharris    'inplace'				=> 46,
44230557Sjimharris    'internal'				=> 48,
45230557Sjimharris    'malloc'				=> 50,
46230557Sjimharris    'signal'				=> 52,
47230557Sjimharris    'substr'				=> 54,
48230557Sjimharris    'syntax'				=> 56,
49230557Sjimharris    'ambiguous'				=> 58,
50230557Sjimharris    'bareword'				=> 60,
51230557Sjimharris    'digit'				=> 62,
52230557Sjimharris    'parenthesis'			=> 64,
53230557Sjimharris    'precedence'			=> 66,
54230557Sjimharris    'printf'				=> 68,
55230557Sjimharris    'prototype'				=> 70,
56230557Sjimharris    'qw'				=> 72,
57230557Sjimharris    'reserved'				=> 74,
58230557Sjimharris    'semicolon'				=> 76,
59230557Sjimharris    'taint'				=> 78,
60230557Sjimharris    'threads'				=> 80,
61230557Sjimharris    'uninitialized'			=> 82,
62230557Sjimharris    'unpack'				=> 84,
63230557Sjimharris    'untie'				=> 86,
64230557Sjimharris    'utf8'				=> 88,
65230557Sjimharris    'void'				=> 90,
66230557Sjimharris
67230557Sjimharris    # Warnings Categories added in Perl 5.011
68230557Sjimharris    'imprecision'			=> 92,
69230557Sjimharris    'illegalproto'			=> 94,
70230557Sjimharris
71230557Sjimharris    # Warnings Categories added in Perl 5.011003
72230557Sjimharris    'deprecated::goto_construct'	=> 96,
73230557Sjimharris    'deprecated::unicode_property_name'	=> 98,
74230557Sjimharris
75230557Sjimharris    # Warnings Categories added in Perl 5.013
76230557Sjimharris    'non_unicode'			=> 100,
77230557Sjimharris    'nonchar'				=> 102,
78230557Sjimharris    'surrogate'				=> 104,
79230557Sjimharris
80230557Sjimharris    # Warnings Categories added in Perl 5.017
81230557Sjimharris    'experimental'			=> 106,
82230557Sjimharris    'experimental::regex_sets'		=> 108,
83230557Sjimharris
84230557Sjimharris    # Warnings Categories added in Perl 5.019
85230557Sjimharris    'syscalls'				=> 110,
86230557Sjimharris
87230557Sjimharris    # Warnings Categories added in Perl 5.021
88230557Sjimharris    'experimental::const_attr'		=> 112,
89230557Sjimharris    'experimental::re_strict'		=> 114,
90230557Sjimharris    'experimental::refaliasing'		=> 116,
91230557Sjimharris    'locale'				=> 118,
92230557Sjimharris    'missing'				=> 120,
93230557Sjimharris    'redundant'				=> 122,
94230557Sjimharris
95230557Sjimharris    # Warnings Categories added in Perl 5.025
96230557Sjimharris    'experimental::declared_refs'	=> 124,
97230557Sjimharris
98230557Sjimharris    # Warnings Categories added in Perl 5.025011
99230557Sjimharris    'deprecated::dot_in_inc'		=> 126,
100230557Sjimharris
101230557Sjimharris    # Warnings Categories added in Perl 5.027
102230557Sjimharris    'shadow'				=> 128,
103230557Sjimharris
104230557Sjimharris    # Warnings Categories added in Perl 5.029
105230557Sjimharris    'experimental::private_use'		=> 130,
106230557Sjimharris    'experimental::uniprop_wildcards'	=> 132,
107230557Sjimharris    'experimental::vlb'			=> 134,
108230557Sjimharris
109230557Sjimharris    # Warnings Categories added in Perl 5.033
110230557Sjimharris    'experimental::try'			=> 136,
111230557Sjimharris
112230557Sjimharris    # Warnings Categories added in Perl 5.035
113230557Sjimharris    'experimental::args_array_with_signatures'=> 138,
114230557Sjimharris    'experimental::builtin'		=> 140,
115230557Sjimharris    'experimental::defer'		=> 142,
116230557Sjimharris    'experimental::extra_paired_delimiters'=> 144,
117230557Sjimharris    'experimental::for_list'		=> 146,
118230557Sjimharris    'scalar'				=> 148,
119230557Sjimharris
120230557Sjimharris    # Warnings Categories added in Perl 5.035009
121230557Sjimharris    'deprecated::version_downgrade'	=> 150,
122230557Sjimharris
123230557Sjimharris    # Warnings Categories added in Perl 5.03501
124230557Sjimharris    'deprecated::delimiter_will_be_paired'=> 152,
125230557Sjimharris
126230557Sjimharris    # Warnings Categories added in Perl 5.037
127230557Sjimharris    'experimental::class'		=> 154,
128230557Sjimharris
129230557Sjimharris    # Warnings Categories added in Perl 5.037009
130230557Sjimharris    'deprecated::apostrophe_as_package_separator'=> 156,
131230557Sjimharris
132230557Sjimharris    # Warnings Categories added in Perl 5.03701
133230557Sjimharris    'deprecated::smartmatch'		=> 158,
134230557Sjimharris);
135230557Sjimharris
136230557Sjimharrisour %Bits = (
137230557Sjimharris    'all'				=> "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..79]
138230557Sjimharris    'ambiguous'				=> "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [29]
139230557Sjimharris    'bareword'				=> "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [30]
140230557Sjimharris    'closed'				=> "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
141230557Sjimharris    'closure'				=> "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
142230557Sjimharris    'debugging'				=> "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [22]
143230557Sjimharris    'deprecated'			=> "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x00\x40\x00\x00\x40\x51", # [2,48,49,63,75,76,78,79]
144230557Sjimharris    'deprecated::apostrophe_as_package_separator'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [78]
145230557Sjimharris    'deprecated::delimiter_will_be_paired'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [76]
146230557Sjimharris    'deprecated::dot_in_inc'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [63]
147230557Sjimharris    'deprecated::goto_construct'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [48]
148230557Sjimharris    'deprecated::smartmatch'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [79]
149230557Sjimharris    'deprecated::unicode_property_name'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [49]
150230557Sjimharris    'deprecated::version_downgrade'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [75]
151230557Sjimharris    'digit'				=> "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [31]
152230557Sjimharris    'exec'				=> "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
153230557Sjimharris    'exiting'				=> "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
154230557Sjimharris    'experimental'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x15\x10\x54\x55\x05\x04", # [53,54,56..58,62,65..73,77]
155230557Sjimharris    'experimental::args_array_with_signatures'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [69]
156230557Sjimharris    'experimental::builtin'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [70]
157230557Sjimharris    'experimental::class'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [77]
158230557Sjimharris    'experimental::const_attr'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [56]
159230557Sjimharris    'experimental::declared_refs'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [62]
160230557Sjimharris    'experimental::defer'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [71]
161230557Sjimharris    'experimental::extra_paired_delimiters'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [72]
162230557Sjimharris    'experimental::for_list'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [73]
163230557Sjimharris    'experimental::private_use'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [65]
164230557Sjimharris    'experimental::re_strict'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [57]
165230557Sjimharris    'experimental::refaliasing'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [58]
166230557Sjimharris    'experimental::regex_sets'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [54]
167230557Sjimharris    'experimental::try'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [68]
168230557Sjimharris    'experimental::uniprop_wildcards'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [66]
169230557Sjimharris    'experimental::vlb'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [67]
170230557Sjimharris    'glob'				=> "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
171230557Sjimharris    'illegalproto'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [47]
172230557Sjimharris    'imprecision'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [46]
173230557Sjimharris    'inplace'				=> "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [23]
174230557Sjimharris    'internal'				=> "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [24]
175230557Sjimharris    'io'				=> "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [5..11,55]
176230557Sjimharris    'layer'				=> "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
177230557Sjimharris    'locale'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [59]
178230557Sjimharris    'malloc'				=> "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [25]
179230557Sjimharris    'misc'				=> "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
180230557Sjimharris    'missing'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [60]
181230557Sjimharris    'newline'				=> "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
182230557Sjimharris    'non_unicode'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [50]
183230557Sjimharris    'nonchar'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [51]
184230557Sjimharris    'numeric'				=> "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
185230557Sjimharris    'once'				=> "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
186230557Sjimharris    'overflow'				=> "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
187230557Sjimharris    'pack'				=> "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
188230557Sjimharris    'parenthesis'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [32]
189230557Sjimharris    'pipe'				=> "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
190230557Sjimharris    'portable'				=> "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
191230557Sjimharris    'precedence'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [33]
192230557Sjimharris    'printf'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [34]
193230557Sjimharris    'prototype'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [35]
194230557Sjimharris    'qw'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [36]
195230557Sjimharris    'recursion'				=> "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
196230557Sjimharris    'redefine'				=> "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
197230557Sjimharris    'redundant'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [61]
198230557Sjimharris    'regexp'				=> "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
199230557Sjimharris    'reserved'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [37]
200230557Sjimharris    'scalar'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [74]
201230557Sjimharris    'semicolon'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [38]
202230557Sjimharris    'severe'				=> "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [21..25]
203230557Sjimharris    'shadow'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [64]
204230557Sjimharris    'signal'				=> "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [26]
205230557Sjimharris    'substr'				=> "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [27]
206230557Sjimharris    'surrogate'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [52]
207230557Sjimharris    'syntax'				=> "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [28..38,47]
208230557Sjimharris    'syscalls'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [55]
209230557Sjimharris    'taint'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [39]
210230557Sjimharris    'threads'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [40]
211230557Sjimharris    'uninitialized'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [41]
212230557Sjimharris    'unopened'				=> "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
213230557Sjimharris    'unpack'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [42]
214230557Sjimharris    'untie'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [43]
215230557Sjimharris    'utf8'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x50\x01\x00\x00\x00\x00\x00\x00", # [44,50..52]
216230557Sjimharris    'void'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [45]
217230557Sjimharris);
218230557Sjimharris
219230557Sjimharrisour %DeadBits = (
220230557Sjimharris    'all'				=> "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..79]
221230557Sjimharris    'ambiguous'				=> "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [29]
222230557Sjimharris    'bareword'				=> "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [30]
223230557Sjimharris    'closed'				=> "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
224230557Sjimharris    'closure'				=> "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
225230557Sjimharris    'debugging'				=> "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [22]
226230557Sjimharris    'deprecated'			=> "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x80\x00\x00\x80\xa2", # [2,48,49,63,75,76,78,79]
227230557Sjimharris    'deprecated::apostrophe_as_package_separator'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [78]
228230557Sjimharris    'deprecated::delimiter_will_be_paired'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [76]
229230557Sjimharris    'deprecated::dot_in_inc'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [63]
230230557Sjimharris    'deprecated::goto_construct'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [48]
231230557Sjimharris    'deprecated::smartmatch'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [79]
232230557Sjimharris    'deprecated::unicode_property_name'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [49]
233230557Sjimharris    'deprecated::version_downgrade'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [75]
234230557Sjimharris    'digit'				=> "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [31]
235230557Sjimharris    'exec'				=> "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
236230557Sjimharris    'exiting'				=> "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
237230557Sjimharris    'experimental'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x2a\x20\xa8\xaa\x0a\x08", # [53,54,56..58,62,65..73,77]
238230557Sjimharris    'experimental::args_array_with_signatures'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [69]
239230557Sjimharris    'experimental::builtin'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [70]
240230557Sjimharris    'experimental::class'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [77]
241230557Sjimharris    'experimental::const_attr'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [56]
242230557Sjimharris    'experimental::declared_refs'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [62]
243230557Sjimharris    'experimental::defer'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [71]
244230557Sjimharris    'experimental::extra_paired_delimiters'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [72]
245230557Sjimharris    'experimental::for_list'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [73]
246230557Sjimharris    'experimental::private_use'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [65]
247230557Sjimharris    'experimental::re_strict'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [57]
248230557Sjimharris    'experimental::refaliasing'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [58]
249230557Sjimharris    'experimental::regex_sets'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [54]
250230557Sjimharris    'experimental::try'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [68]
251230557Sjimharris    'experimental::uniprop_wildcards'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [66]
252230557Sjimharris    'experimental::vlb'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [67]
253230557Sjimharris    'glob'				=> "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
254230557Sjimharris    'illegalproto'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [47]
255230557Sjimharris    'imprecision'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [46]
256230557Sjimharris    'inplace'				=> "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [23]
257230557Sjimharris    'internal'				=> "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [24]
258230557Sjimharris    'io'				=> "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [5..11,55]
259230557Sjimharris    'layer'				=> "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
260230557Sjimharris    'locale'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [59]
261230557Sjimharris    'malloc'				=> "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [25]
262230557Sjimharris    'misc'				=> "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
263230557Sjimharris    'missing'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [60]
264230557Sjimharris    'newline'				=> "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
265230557Sjimharris    'non_unicode'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [50]
266230557Sjimharris    'nonchar'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [51]
267230557Sjimharris    'numeric'				=> "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
268230557Sjimharris    'once'				=> "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
269230557Sjimharris    'overflow'				=> "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
270230557Sjimharris    'pack'				=> "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
271230557Sjimharris    'parenthesis'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [32]
272230557Sjimharris    'pipe'				=> "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
273230557Sjimharris    'portable'				=> "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
274230557Sjimharris    'precedence'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [33]
275230557Sjimharris    'printf'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [34]
276230557Sjimharris    'prototype'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [35]
277230557Sjimharris    'qw'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [36]
278230557Sjimharris    'recursion'				=> "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
279230557Sjimharris    'redefine'				=> "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
280230557Sjimharris    'redundant'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [61]
281230557Sjimharris    'regexp'				=> "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
282230557Sjimharris    'reserved'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [37]
283230557Sjimharris    'scalar'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [74]
284230557Sjimharris    'semicolon'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [38]
285230557Sjimharris    'severe'				=> "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [21..25]
286230557Sjimharris    'shadow'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [64]
287230557Sjimharris    'signal'				=> "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [26]
288230557Sjimharris    'substr'				=> "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [27]
289230557Sjimharris    'surrogate'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [52]
290230557Sjimharris    'syntax'				=> "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [28..38,47]
291230557Sjimharris    'syscalls'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [55]
292230557Sjimharris    'taint'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [39]
293230557Sjimharris    'threads'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [40]
294230557Sjimharris    'uninitialized'			=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [41]
295230557Sjimharris    'unopened'				=> "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
296230557Sjimharris    'unpack'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [42]
297230557Sjimharris    'untie'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [43]
298230557Sjimharris    'utf8'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\xa0\x02\x00\x00\x00\x00\x00\x00", # [44,50..52]
299230557Sjimharris    'void'				=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [45]
300230557Sjimharris);
301230557Sjimharris
302230557Sjimharrisour %NoOp = (
303230557Sjimharris    'experimental::alpha_assertions'	=> 1,
304230557Sjimharris    'experimental::bitwise'		=> 1,
305230557Sjimharris    'experimental::isa'			=> 1,
306230557Sjimharris    'experimental::lexical_subs'	=> 1,
307230557Sjimharris    'experimental::postderef'		=> 1,
308230557Sjimharris    'experimental::script_run'		=> 1,
309230557Sjimharris    'experimental::signatures'		=> 1,
310230557Sjimharris    'experimental::smartmatch'		=> 1,
311230557Sjimharris);
312230557Sjimharris
313230557Sjimharris# These are used by various things, including our own tests
314230557Sjimharrisour $NONE				=  "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
315230557Sjimharrisour $DEFAULT				=  "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x05\x00\x55\x50\x54\x55\x45\x55"; # [2,4,22,23,25,48,49,56..59,62,63,65..73,75..79]
316230557Sjimharrisour $LAST_BIT				=  160 ;
317230557Sjimharrisour $BYTES				=  20 ;
318230557Sjimharris
319230557Sjimharrissub Croaker
320230557Sjimharris{
321230557Sjimharris    require Carp; # this initializes %CarpInternal
322230557Sjimharris    local $Carp::CarpInternal{'warnings'};
323230557Sjimharris    delete $Carp::CarpInternal{'warnings'};
324230557Sjimharris    Carp::croak(@_);
325230557Sjimharris}
326230557Sjimharris
327230557Sjimharrissub _expand_bits {
328230557Sjimharris    my $bits = shift;
329230557Sjimharris    my $want_len = ($LAST_BIT + 7) >> 3;
330230557Sjimharris    my $len = length($bits);
331230557Sjimharris    if ($len != $want_len) {
332230557Sjimharris        if ($bits eq "") {
333230557Sjimharris            $bits = "\x00" x $want_len;
334230557Sjimharris        } elsif ($len > $want_len) {
335230557Sjimharris            substr $bits, $want_len, $len-$want_len, "";
336230557Sjimharris        } else {
337230557Sjimharris            my $x = vec($bits, $Offsets{all} >> 1, 2);
338230557Sjimharris            $x |= $x << 2;
339230557Sjimharris            $x |= $x << 4;
340230557Sjimharris            $bits .= chr($x) x ($want_len - $len);
341230557Sjimharris        }
342230557Sjimharris    }
343230557Sjimharris    return $bits;
344230557Sjimharris}
345230557Sjimharris
346230557Sjimharrissub _bits {
347230557Sjimharris    my $mask = shift ;
348230557Sjimharris    my $catmask ;
349230557Sjimharris    my $fatal = 0 ;
350230557Sjimharris    my $no_fatal = 0 ;
351230557Sjimharris
352230557Sjimharris    $mask = _expand_bits($mask);
353230557Sjimharris    foreach my $word ( @_ ) {
354230557Sjimharris        next if $NoOp{$word};
355230557Sjimharris        if ($word eq 'FATAL') {
356230557Sjimharris            $fatal = 1;
357230557Sjimharris            $no_fatal = 0;
358230557Sjimharris        }
359230557Sjimharris        elsif ($word eq 'NONFATAL') {
360230557Sjimharris            $fatal = 0;
361230557Sjimharris            $no_fatal = 1;
362230557Sjimharris        }
363230557Sjimharris        elsif ($catmask = $Bits{$word}) {
364230557Sjimharris            $mask |= $catmask ;
365230557Sjimharris            $mask |= $DeadBits{$word} if $fatal ;
366230557Sjimharris            $mask = ~(~$mask | $DeadBits{$word}) if $no_fatal ;
367230557Sjimharris        }
368230557Sjimharris        else
369230557Sjimharris          { Croaker("Unknown warnings category '$word'")}
370230557Sjimharris    }
371230557Sjimharris
372230557Sjimharris    return $mask ;
373230557Sjimharris}
374230557Sjimharris
375230557Sjimharrissub bits
376230557Sjimharris{
377230557Sjimharris    # called from B::Deparse.pm
378230557Sjimharris    push @_, 'all' unless @_ ;
379230557Sjimharris    return _bits("", @_) ;
380230557Sjimharris}
381230557Sjimharris
382230557Sjimharrissub import
383230557Sjimharris{
384230557Sjimharris    my $invocant = shift;
385230557Sjimharris
386230557Sjimharris    # append 'all' when implied (empty import list or after a lone
387230557Sjimharris    # "FATAL" or "NONFATAL")
388230557Sjimharris    push @_, 'all'
389230557Sjimharris        if !@_ || (@_==1 && ($_[0] eq 'FATAL' || $_[0] eq 'NONFATAL'));
390230557Sjimharris
391230557Sjimharris    my @fatal = ();
392230557Sjimharris    foreach my $warning (@_) {
393230557Sjimharris        if($warning =~ /^(NON)?FATAL$/) {
394230557Sjimharris            @fatal = ($warning);
395230557Sjimharris        } elsif(substr($warning, 0, 1) ne '-') {
396230557Sjimharris            my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
397230557Sjimharris            ${^WARNING_BITS} = _bits($mask, @fatal, $warning);
398230557Sjimharris        } else {
399230557Sjimharris            $invocant->unimport(substr($warning, 1));
400230557Sjimharris        }
401230557Sjimharris    }
402230557Sjimharris}
403230557Sjimharris
404230557Sjimharrissub unimport
405230557Sjimharris{
406230557Sjimharris    shift;
407230557Sjimharris
408230557Sjimharris    my $catmask ;
409230557Sjimharris    my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
410230557Sjimharris
411230557Sjimharris    # append 'all' when implied (empty import list or after a lone "FATAL")
412230557Sjimharris    push @_, 'all' if !@_ || @_==1 && $_[0] eq 'FATAL';
413230557Sjimharris
414230557Sjimharris    $mask = _expand_bits($mask);
415230557Sjimharris    foreach my $word ( @_ ) {
416230557Sjimharris        next if $NoOp{$word};
417230557Sjimharris        if ($word eq 'FATAL') {
418230557Sjimharris            next;
419230557Sjimharris        }
420230557Sjimharris        elsif ($catmask = $Bits{$word}) {
421230557Sjimharris            $mask = ~(~$mask | $catmask | $DeadBits{$word});
422230557Sjimharris        }
423230557Sjimharris        else
424230557Sjimharris          { Croaker("Unknown warnings category '$word'")}
425230557Sjimharris    }
426230557Sjimharris
427230557Sjimharris    ${^WARNING_BITS} = $mask ;
428230557Sjimharris}
429230557Sjimharris
430230557Sjimharrismy %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
431230557Sjimharris
432230557Sjimharrissub LEVEL () { 8 };
433230557Sjimharrissub MESSAGE () { 4 };
434230557Sjimharrissub FATAL () { 2 };
435230557Sjimharrissub NORMAL () { 1 };
436230557Sjimharris
437230557Sjimharrissub __chk
438230557Sjimharris{
439230557Sjimharris    my $category ;
440230557Sjimharris    my $offset ;
441230557Sjimharris    my $isobj = 0 ;
442230557Sjimharris    my $wanted = shift;
443230557Sjimharris    my $has_message = $wanted & MESSAGE;
444230557Sjimharris    my $has_level   = $wanted & LEVEL  ;
445230557Sjimharris
446230557Sjimharris    if ($has_level) {
447230557Sjimharris        if (@_ != ($has_message ? 3 : 2)) {
448230557Sjimharris            my $sub = (caller 1)[3];
449230557Sjimharris            my $syntax = $has_message
450230557Sjimharris                ? "category, level, 'message'"
451230557Sjimharris                : 'category, level';
452230557Sjimharris            Croaker("Usage: $sub($syntax)");
453230557Sjimharris        }
454230557Sjimharris    }
455230557Sjimharris    elsif (not @_ == 1 || @_ == ($has_message ? 2 : 0)) {
456230557Sjimharris        my $sub = (caller 1)[3];
457230557Sjimharris        my $syntax = $has_message ? "[category,] 'message'" : '[category]';
458230557Sjimharris        Croaker("Usage: $sub($syntax)");
459230557Sjimharris    }
460230557Sjimharris
461230557Sjimharris    my $message = pop if $has_message;
462230557Sjimharris
463230557Sjimharris    if (@_) {
464230557Sjimharris        # check the category supplied.
465230557Sjimharris        $category = shift ;
466230557Sjimharris        if (my $type = ref $category) {
467230557Sjimharris            Croaker("not an object")
468230557Sjimharris                if exists $builtin_type{$type};
469230557Sjimharris            $category = $type;
470230557Sjimharris            $isobj = 1 ;
471230557Sjimharris        }
472230557Sjimharris        $offset = $Offsets{$category};
473230557Sjimharris        Croaker("Unknown warnings category '$category'")
474230557Sjimharris            unless defined $offset;
475230557Sjimharris    }
476230557Sjimharris    else {
477230557Sjimharris        $category = caller(1);
478230557Sjimharris        $offset = $Offsets{$category};
479230557Sjimharris        Croaker("package '$category' not registered for warnings")
480230557Sjimharris            unless defined $offset ;
481230557Sjimharris    }
482230557Sjimharris
483230557Sjimharris    my $i;
484230557Sjimharris
485230557Sjimharris    if ($isobj) {
486230557Sjimharris        my $pkg;
487230557Sjimharris        $i = 2;
488230557Sjimharris        while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
489230557Sjimharris            last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
490230557Sjimharris        }
491230557Sjimharris        $i -= 2 ;
492230557Sjimharris    }
493230557Sjimharris    elsif ($has_level) {
494230557Sjimharris        $i = 2 + shift;
495230557Sjimharris    }
496230557Sjimharris    else {
497230557Sjimharris        $i = _error_loc(); # see where Carp will allocate the error
498230557Sjimharris    }
499230557Sjimharris
500230557Sjimharris    # Default to 0 if caller returns nothing.  Default to $DEFAULT if it
501230557Sjimharris    # explicitly returns undef.
502230557Sjimharris    my(@callers_bitmask) = (caller($i))[9] ;
503230557Sjimharris    my $callers_bitmask =
504230557Sjimharris         @callers_bitmask ? $callers_bitmask[0] // $DEFAULT : 0 ;
505230557Sjimharris    length($callers_bitmask) > ($offset >> 3) or $offset = $Offsets{all};
506230557Sjimharris
507230557Sjimharris    my @results;
508230557Sjimharris    foreach my $type (FATAL, NORMAL) {
509230557Sjimharris        next unless $wanted & $type;
510230557Sjimharris
511230557Sjimharris        push @results, vec($callers_bitmask, $offset + $type - 1, 1);
512230557Sjimharris    }
513230557Sjimharris
514230557Sjimharris    # &enabled and &fatal_enabled
515230557Sjimharris    return $results[0] unless $has_message;
516230557Sjimharris
517230557Sjimharris    # &warnif, and the category is neither enabled as warning nor as fatal
518230557Sjimharris    return if ($wanted & (NORMAL | FATAL | MESSAGE))
519230557Sjimharris                      == (NORMAL | FATAL | MESSAGE)
520230557Sjimharris        && !($results[0] || $results[1]);
521230557Sjimharris
522230557Sjimharris    # If we have an explicit level, bypass Carp.
523230557Sjimharris    if ($has_level and @callers_bitmask) {
524230557Sjimharris        # logic copied from util.c:mess_sv
525230557Sjimharris        my $stuff = " at " . join " line ", (caller $i)[1,2];
526230557Sjimharris        $stuff .= sprintf ", <%s> %s %d",
527230557Sjimharris                           *${^LAST_FH}{NAME},
528230557Sjimharris                           ($/ eq "\n" ? "line" : "chunk"), $.
529230557Sjimharris            if $. && ${^LAST_FH};
530230557Sjimharris        die "$message$stuff.\n" if $results[0];
531230557Sjimharris        return warn "$message$stuff.\n";
532230557Sjimharris    }
533230557Sjimharris
534230557Sjimharris    require Carp;
535230557Sjimharris    Carp::croak($message) if $results[0];
536230557Sjimharris    # will always get here for &warn. will only get here for &warnif if the
537230557Sjimharris    # category is enabled
538230557Sjimharris    Carp::carp($message);
539230557Sjimharris}
540230557Sjimharris
541230557Sjimharrissub _mkMask
542230557Sjimharris{
543230557Sjimharris    my ($bit) = @_;
544230557Sjimharris    my $mask = "";
545230557Sjimharris
546230557Sjimharris    vec($mask, $bit, 1) = 1;
547230557Sjimharris    return $mask;
548230557Sjimharris}
549230557Sjimharris
550230557Sjimharrissub register_categories
551230557Sjimharris{
552230557Sjimharris    my @names = @_;
553230557Sjimharris
554230557Sjimharris    for my $name (@names) {
555230557Sjimharris        if (! defined $Bits{$name}) {
556230557Sjimharris            $Offsets{$name}  = $LAST_BIT;
557230557Sjimharris            $Bits{$name}     = _mkMask($LAST_BIT++);
558230557Sjimharris            $DeadBits{$name} = _mkMask($LAST_BIT++);
559230557Sjimharris            if (length($Bits{$name}) > length($Bits{all})) {
560230557Sjimharris                $Bits{all} .= "\x55";
561230557Sjimharris                $DeadBits{all} .= "\xaa";
562230557Sjimharris            }
563230557Sjimharris        }
564230557Sjimharris    }
565230557Sjimharris}
566230557Sjimharris
567230557Sjimharrissub _error_loc {
568230557Sjimharris    require Carp;
569230557Sjimharris    goto &Carp::short_error_loc; # don't introduce another stack frame
570230557Sjimharris}
571230557Sjimharris
572230557Sjimharrissub enabled
573230557Sjimharris{
574230557Sjimharris    return __chk(NORMAL, @_);
575230557Sjimharris}
576230557Sjimharris
577230557Sjimharrissub fatal_enabled
578230557Sjimharris{
579230557Sjimharris    return __chk(FATAL, @_);
580230557Sjimharris}
581230557Sjimharris
582230557Sjimharrissub warn
583230557Sjimharris{
584230557Sjimharris    return __chk(FATAL | MESSAGE, @_);
585230557Sjimharris}
586230557Sjimharris
587230557Sjimharrissub warnif
588230557Sjimharris{
589230557Sjimharris    return __chk(NORMAL | FATAL | MESSAGE, @_);
590230557Sjimharris}
591230557Sjimharris
592230557Sjimharrissub enabled_at_level
593230557Sjimharris{
594230557Sjimharris    return __chk(NORMAL | LEVEL, @_);
595230557Sjimharris}
596230557Sjimharris
597230557Sjimharrissub fatal_enabled_at_level
598230557Sjimharris{
599230557Sjimharris    return __chk(FATAL | LEVEL, @_);
600230557Sjimharris}
601230557Sjimharris
602230557Sjimharrissub warn_at_level
603230557Sjimharris{
604230557Sjimharris    return __chk(FATAL | MESSAGE | LEVEL, @_);
605230557Sjimharris}
606230557Sjimharris
607230557Sjimharrissub warnif_at_level
608230557Sjimharris{
609230557Sjimharris    return __chk(NORMAL | FATAL | MESSAGE | LEVEL, @_);
610230557Sjimharris}
611230557Sjimharris
612230557Sjimharris# These are not part of any public interface, so we can delete them to save
613# space.
614delete @warnings::{qw(NORMAL FATAL MESSAGE LEVEL)};
615
6161;
617__END__
618
619=head1 NAME
620
621warnings - Perl pragma to control optional warnings
622
623=head1 SYNOPSIS
624
625    use warnings;
626    no warnings;
627
628    # Standard warnings are enabled by use v5.35 or above
629    use v5.35;
630
631    use warnings "all";
632    no warnings "uninitialized";
633
634    # or equivalent to those last two ...
635    use warnings qw(all -uninitialized);
636
637    use warnings::register;
638    if (warnings::enabled()) {
639        warnings::warn("some warning");
640    }
641
642    if (warnings::enabled("void")) {
643        warnings::warn("void", "some warning");
644    }
645
646    if (warnings::enabled($object)) {
647        warnings::warn($object, "some warning");
648    }
649
650    warnings::warnif("some warning");
651    warnings::warnif("void", "some warning");
652    warnings::warnif($object, "some warning");
653
654=head1 DESCRIPTION
655
656The C<warnings> pragma gives control over which warnings are enabled in
657which parts of a Perl program.  It's a more flexible alternative for
658both the command line flag B<-w> and the equivalent Perl variable,
659C<$^W>.
660
661This pragma works just like the C<strict> pragma.
662This means that the scope of the warning pragma is limited to the
663enclosing block.  It also means that the pragma setting will not
664leak across files (via C<use>, C<require> or C<do>).  This allows
665authors to independently define the degree of warning checks that will
666be applied to their module.
667
668By default, optional warnings are disabled, so any legacy code that
669doesn't attempt to control the warnings will work unchanged.
670
671All warnings are enabled in a block by either of these:
672
673    use warnings;
674    use warnings 'all';
675
676Similarly all warnings are disabled in a block by either of these:
677
678    no warnings;
679    no warnings 'all';
680
681For example, consider the code below:
682
683    use warnings;
684    my @x;
685    {
686        no warnings;
687        my $y = @x[0];
688    }
689    my $z = @x[0];
690
691The code in the enclosing block has warnings enabled, but the inner
692block has them disabled.  In this case that means the assignment to the
693scalar C<$z> will trip the C<"Scalar value @x[0] better written as $x[0]">
694warning, but the assignment to the scalar C<$y> will not.
695
696All warnings are enabled automatically within the scope of
697a C<L<use v5.35|perlfunc/use VERSION>> (or higher) declaration.
698
699=head2 Default Warnings and Optional Warnings
700
701Before the introduction of lexical warnings, Perl had two classes of
702warnings: mandatory and optional.
703
704As its name suggests, if your code tripped a mandatory warning, you
705would get a warning whether you wanted it or not.
706For example, the code below would always produce an C<"isn't numeric">
707warning about the "2:".
708
709    my $x = "2:" + 3;
710
711With the introduction of lexical warnings, mandatory warnings now become
712I<default> warnings.  The difference is that although the previously
713mandatory warnings are still enabled by default, they can then be
714subsequently enabled or disabled with the lexical warning pragma.  For
715example, in the code below, an C<"isn't numeric"> warning will only
716be reported for the C<$x> variable.
717
718    my $x = "2:" + 3;
719    no warnings;
720    my $y = "2:" + 3;
721
722Note that neither the B<-w> flag or the C<$^W> can be used to
723disable/enable default warnings.  They are still mandatory in this case.
724
725=head2 "Negative warnings"
726
727As a convenience, you can (as of Perl 5.34) pass arguments to the
728C<import()> method both positively and negatively. Negative warnings
729are those with a C<-> sign prepended to their names; positive warnings
730are anything else. This lets you turn on some warnings and turn off
731others in one command. So, assuming that you've already turned on a
732bunch of warnings but want to tweak them a bit in some block, you can
733do this:
734
735    {
736        use warnings qw(uninitialized -redefine);
737        ...
738    }
739
740which is equivalent to:
741
742    {
743        use warnings qw(uninitialized);
744        no warnings qw(redefine);
745        ...
746    }
747
748The argument list is processed in the order you specify. So, for example, if you
749don't want to be warned about use of experimental features, except for C<somefeature>
750that you really dislike, you can say this:
751
752    use warnings qw(all -experimental experimental::somefeature);
753
754which is equivalent to:
755
756    use warnings 'all';
757    no warnings  'experimental';
758    use warnings 'experimental::somefeature';
759
760As experimental features become regular features of Perl,
761the corresponding warnings are not printed anymore.
762They also stop being listed in the L</Category Hierarchy> below.
763
764It is still possible to request turning on or off these warnings,
765but doing so has no effect.
766
767=head2 What's wrong with B<-w> and C<$^W>
768
769Although very useful, the big problem with using B<-w> on the command
770line to enable warnings is that it is all or nothing.  Take the typical
771scenario when you are writing a Perl program.  Parts of the code you
772will write yourself, but it's very likely that you will make use of
773pre-written Perl modules.  If you use the B<-w> flag in this case, you
774end up enabling warnings in pieces of code that you haven't written.
775
776Similarly, using C<$^W> to either disable or enable blocks of code is
777fundamentally flawed.  For a start, say you want to disable warnings in
778a block of code.  You might expect this to be enough to do the trick:
779
780     {
781         local ($^W) = 0;
782         my $x =+ 2;
783         my $y; chop $y;
784     }
785
786When this code is run with the B<-w> flag, a warning will be produced
787for the C<$x> line:  C<"Reversed += operator">.
788
789The problem is that Perl has both compile-time and run-time warnings.  To
790disable compile-time warnings you need to rewrite the code like this:
791
792     {
793         BEGIN { $^W = 0 }
794         my $x =+ 2;
795         my $y; chop $y;
796     }
797
798And note that unlike the first example, this will permanently set C<$^W>
799since it cannot both run during compile-time and be localized to a
800run-time block.
801
802The other big problem with C<$^W> is the way you can inadvertently
803change the warning setting in unexpected places in your code.  For example,
804when the code below is run (without the B<-w> flag), the second call
805to C<doit> will trip a C<"Use of uninitialized value"> warning, whereas
806the first will not.
807
808    sub doit
809    {
810        my $y; chop $y;
811    }
812
813    doit();
814
815    {
816        local ($^W) = 1;
817        doit()
818    }
819
820This is a side-effect of C<$^W> being dynamically scoped.
821
822Lexical warnings get around these limitations by allowing finer control
823over where warnings can or can't be tripped.
824
825=head2 Controlling Warnings from the Command Line
826
827There are three Command Line flags that can be used to control when
828warnings are (or aren't) produced:
829
830=over 5
831
832=item B<-w>
833X<-w>
834
835This is  the existing flag.  If the lexical warnings pragma is B<not>
836used in any of your code, or any of the modules that you use, this flag
837will enable warnings everywhere.  See L</Backward Compatibility> for
838details of how this flag interacts with lexical warnings.
839
840=item B<-W>
841X<-W>
842
843If the B<-W> flag is used on the command line, it will enable all warnings
844throughout the program regardless of whether warnings were disabled
845locally using C<no warnings> or C<$^W =0>.
846This includes all files that get
847included via C<use>, C<require> or C<do>.
848Think of it as the Perl equivalent of the "lint" command.
849
850=item B<-X>
851X<-X>
852
853Does the exact opposite to the B<-W> flag, i.e. it disables all warnings.
854
855=back
856
857=head2 Backward Compatibility
858
859If you are used to working with a version of Perl prior to the
860introduction of lexically scoped warnings, or have code that uses both
861lexical warnings and C<$^W>, this section will describe how they interact.
862
863How Lexical Warnings interact with B<-w>/C<$^W>:
864
865=over 5
866
867=item 1.
868
869If none of the three command line flags (B<-w>, B<-W> or B<-X>) that
870control warnings is used and neither C<$^W> nor the C<warnings> pragma
871are used, then default warnings will be enabled and optional warnings
872disabled.
873This means that legacy code that doesn't attempt to control the warnings
874will work unchanged.
875
876=item 2.
877
878The B<-w> flag just sets the global C<$^W> variable as in 5.005.  This
879means that any legacy code that currently relies on manipulating C<$^W>
880to control warning behavior will still work as is.
881
882=item 3.
883
884Apart from now being a boolean, the C<$^W> variable operates in exactly
885the same horrible uncontrolled global way, except that it cannot
886disable/enable default warnings.
887
888=item 4.
889
890If a piece of code is under the control of the C<warnings> pragma,
891both the C<$^W> variable and the B<-w> flag will be ignored for the
892scope of the lexical warning.
893
894=item 5.
895
896The only way to override a lexical warnings setting is with the B<-W>
897or B<-X> command line flags.
898
899=back
900
901The combined effect of 3 & 4 is that it will allow code which uses
902the C<warnings> pragma to control the warning behavior of $^W-type
903code (using a C<local $^W=0>) if it really wants to, but not vice-versa.
904
905=head2 Category Hierarchy
906X<warning, categories>
907
908A hierarchy of "categories" have been defined to allow groups of warnings
909to be enabled/disabled in isolation.
910
911The current hierarchy is:
912
913    all -+
914         |
915         +- closure
916         |
917         +- deprecated ----+
918         |                 |
919         |                 +- deprecated::apostrophe_as_package_separator
920         |                 |
921         |                 +- deprecated::delimiter_will_be_paired
922         |                 |
923         |                 +- deprecated::dot_in_inc
924         |                 |
925         |                 +- deprecated::goto_construct
926         |                 |
927         |                 +- deprecated::smartmatch
928         |                 |
929         |                 +- deprecated::unicode_property_name
930         |                 |
931         |                 +- deprecated::version_downgrade
932         |
933         +- exiting
934         |
935         +- experimental --+
936         |                 |
937         |                 +- experimental::args_array_with_signatures
938         |                 |
939         |                 +- experimental::builtin
940         |                 |
941         |                 +- experimental::class
942         |                 |
943         |                 +- experimental::const_attr
944         |                 |
945         |                 +- experimental::declared_refs
946         |                 |
947         |                 +- experimental::defer
948         |                 |
949         |                 +- experimental::extra_paired_delimiters
950         |                 |
951         |                 +- experimental::for_list
952         |                 |
953         |                 +- experimental::private_use
954         |                 |
955         |                 +- experimental::re_strict
956         |                 |
957         |                 +- experimental::refaliasing
958         |                 |
959         |                 +- experimental::regex_sets
960         |                 |
961         |                 +- experimental::try
962         |                 |
963         |                 +- experimental::uniprop_wildcards
964         |                 |
965         |                 +- experimental::vlb
966         |
967         +- glob
968         |
969         +- imprecision
970         |
971         +- io ------------+
972         |                 |
973         |                 +- closed
974         |                 |
975         |                 +- exec
976         |                 |
977         |                 +- layer
978         |                 |
979         |                 +- newline
980         |                 |
981         |                 +- pipe
982         |                 |
983         |                 +- syscalls
984         |                 |
985         |                 +- unopened
986         |
987         +- locale
988         |
989         +- misc
990         |
991         +- missing
992         |
993         +- numeric
994         |
995         +- once
996         |
997         +- overflow
998         |
999         +- pack
1000         |
1001         +- portable
1002         |
1003         +- recursion
1004         |
1005         +- redefine
1006         |
1007         +- redundant
1008         |
1009         +- regexp
1010         |
1011         +- scalar
1012         |
1013         +- severe --------+
1014         |                 |
1015         |                 +- debugging
1016         |                 |
1017         |                 +- inplace
1018         |                 |
1019         |                 +- internal
1020         |                 |
1021         |                 +- malloc
1022         |
1023         +- shadow
1024         |
1025         +- signal
1026         |
1027         +- substr
1028         |
1029         +- syntax --------+
1030         |                 |
1031         |                 +- ambiguous
1032         |                 |
1033         |                 +- bareword
1034         |                 |
1035         |                 +- digit
1036         |                 |
1037         |                 +- illegalproto
1038         |                 |
1039         |                 +- parenthesis
1040         |                 |
1041         |                 +- precedence
1042         |                 |
1043         |                 +- printf
1044         |                 |
1045         |                 +- prototype
1046         |                 |
1047         |                 +- qw
1048         |                 |
1049         |                 +- reserved
1050         |                 |
1051         |                 +- semicolon
1052         |
1053         +- taint
1054         |
1055         +- threads
1056         |
1057         +- uninitialized
1058         |
1059         +- unpack
1060         |
1061         +- untie
1062         |
1063         +- utf8 ----------+
1064         |                 |
1065         |                 +- non_unicode
1066         |                 |
1067         |                 +- nonchar
1068         |                 |
1069         |                 +- surrogate
1070         |
1071         +- void
1072
1073Just like the "strict" pragma any of these categories can be combined
1074
1075    use warnings qw(void redefine);
1076    no warnings qw(io syntax untie);
1077
1078Also like the "strict" pragma, if there is more than one instance of the
1079C<warnings> pragma in a given scope the cumulative effect is additive.
1080
1081    use warnings qw(void); # only "void" warnings enabled
1082    ...
1083    use warnings qw(io);   # only "void" & "io" warnings enabled
1084    ...
1085    no warnings qw(void);  # only "io" warnings enabled
1086
1087To determine which category a specific warning has been assigned to see
1088L<perldiag>.
1089
1090Note: Before Perl 5.8.0, the lexical warnings category "deprecated" was a
1091sub-category of the "syntax" category.  It is now a top-level category
1092in its own right.
1093
1094Note: Before 5.21.0, the "missing" lexical warnings category was
1095internally defined to be the same as the "uninitialized" category. It
1096is now a top-level category in its own right.
1097
1098=head2 Fatal Warnings
1099X<warning, fatal>
1100
1101The presence of the word "FATAL" in the category list will escalate
1102warnings in those categories into fatal errors in that lexical scope.
1103
1104B<NOTE:> FATAL warnings should be used with care, particularly
1105C<< FATAL => 'all' >>.
1106
1107Libraries using L<warnings::warn|/FUNCTIONS> for custom warning categories
1108generally don't expect L<warnings::warn|/FUNCTIONS> to be fatal and can wind up
1109in an unexpected state as a result.  For XS modules issuing categorized
1110warnings, such unanticipated exceptions could also expose memory leak bugs.
1111
1112Moreover, the Perl interpreter itself has had serious bugs involving
1113fatalized warnings.  For a summary of resolved and unresolved problems as
1114of January 2015, please see
1115L<this perl5-porters post|http://www.nntp.perl.org/group/perl.perl5.porters/2015/01/msg225235.html>.
1116
1117While some developers find fatalizing some warnings to be a useful
1118defensive programming technique, using C<< FATAL => 'all' >> to fatalize
1119all possible warning categories -- including custom ones -- is particularly
1120risky.  Therefore, the use of C<< FATAL => 'all' >> is
1121L<discouraged|perlpolicy/discouraged>.
1122
1123The L<strictures|strictures/VERSION-2> module on CPAN offers one example of
1124a warnings subset that the module's authors believe is relatively safe to
1125fatalize.
1126
1127B<NOTE:> Users of FATAL warnings, especially those using
1128C<< FATAL => 'all' >>, should be fully aware that they are risking future
1129portability of their programs by doing so.  Perl makes absolutely no
1130commitments to not introduce new warnings or warnings categories in the
1131future; indeed, we explicitly reserve the right to do so.  Code that may
1132not warn now may warn in a future release of Perl if the Perl5 development
1133team deems it in the best interests of the community to do so.  Should code
1134using FATAL warnings break due to the introduction of a new warning we will
1135NOT consider it an incompatible change.  Users of FATAL warnings should
1136take special caution during upgrades to check to see if their code triggers
1137any new warnings and should pay particular attention to the fine print of
1138the documentation of the features they use to ensure they do not exploit
1139features that are documented as risky, deprecated, or unspecified, or where
1140the documentation says "so don't do that", or anything with the same sense
1141and spirit.  Use of such features in combination with FATAL warnings is
1142ENTIRELY AT THE USER'S RISK.
1143
1144The following documentation describes how to use FATAL warnings but the
1145perl5 porters strongly recommend that you understand the risks before doing
1146so, especially for library code intended for use by others, as there is no
1147way for downstream users to change the choice of fatal categories.
1148
1149In the code below, the use of C<time>, C<length>
1150and C<join> can all produce a C<"Useless use of xxx in void context">
1151warning.
1152
1153    use warnings;
1154
1155    time;
1156
1157    {
1158        use warnings FATAL => qw(void);
1159        length "abc";
1160    }
1161
1162    join "", 1,2,3;
1163
1164    print "done\n";
1165
1166When run it produces this output
1167
1168    Useless use of time in void context at fatal line 3.
1169    Useless use of length in void context at fatal line 7.
1170
1171The scope where C<length> is used has escalated the C<void> warnings
1172category into a fatal error, so the program terminates immediately when it
1173encounters the warning.
1174
1175To explicitly turn off a "FATAL" warning you just disable the warning
1176it is associated with.  So, for example, to disable the "void" warning
1177in the example above, either of these will do the trick:
1178
1179    no warnings qw(void);
1180    no warnings FATAL => qw(void);
1181
1182If you want to downgrade a warning that has been escalated into a fatal
1183error back to a normal warning, you can use the "NONFATAL" keyword.  For
1184example, the code below will promote all warnings into fatal errors,
1185except for those in the "syntax" category.
1186
1187    use warnings FATAL => 'all', NONFATAL => 'syntax';
1188
1189As of Perl 5.20, instead of C<< use warnings FATAL => 'all'; >> you can
1190use:
1191
1192   use v5.20;       # Perl 5.20 or greater is required for the following
1193   use warnings 'FATAL';  # short form of "use warnings FATAL => 'all';"
1194
1195However, you should still heed the guidance earlier in this section against
1196using C<< use warnings FATAL => 'all'; >>.
1197
1198If you want your program to be compatible with versions of Perl before
11995.20, you must use C<< use warnings FATAL => 'all'; >> instead.  (In
1200previous versions of Perl, the behavior of the statements
1201C<< use warnings 'FATAL'; >>, C<< use warnings 'NONFATAL'; >> and
1202C<< no warnings 'FATAL'; >> was unspecified; they did not behave as if
1203they included the C<< => 'all' >> portion.  As of 5.20, they do.)
1204
1205=head2 Reporting Warnings from a Module
1206X<warning, reporting> X<warning, registering>
1207
1208The C<warnings> pragma provides a number of functions that are useful for
1209module authors.  These are used when you want to report a module-specific
1210warning to a calling module has enabled warnings via the C<warnings>
1211pragma.
1212
1213Consider the module C<MyMod::Abc> below.
1214
1215    package MyMod::Abc;
1216
1217    use warnings::register;
1218
1219    sub open {
1220        my $path = shift;
1221        if ($path !~ m#^/#) {
1222            warnings::warn("changing relative path to /var/abc")
1223                if warnings::enabled();
1224            $path = "/var/abc/$path";
1225        }
1226    }
1227
1228    1;
1229
1230The call to C<warnings::register> will create a new warnings category
1231called "MyMod::Abc", i.e. the new category name matches the current
1232package name.  The C<open> function in the module will display a warning
1233message if it gets given a relative path as a parameter.  This warnings
1234will only be displayed if the code that uses C<MyMod::Abc> has actually
1235enabled them with the C<warnings> pragma like below.
1236
1237    use MyMod::Abc;
1238    use warnings 'MyMod::Abc';
1239    ...
1240    abc::open("../fred.txt");
1241
1242It is also possible to test whether the pre-defined warnings categories are
1243set in the calling module with the C<warnings::enabled> function.  Consider
1244this snippet of code:
1245
1246    package MyMod::Abc;
1247
1248    sub open {
1249        if (warnings::enabled("deprecated")) {
1250            warnings::warn("deprecated",
1251                           "open is deprecated, use new instead");
1252        }
1253        new(@_);
1254    }
1255
1256    sub new
1257    ...
1258    1;
1259
1260The function C<open> has been deprecated, so code has been included to
1261display a warning message whenever the calling module has (at least) the
1262"deprecated" warnings category enabled.  Something like this, say.
1263
1264    use warnings 'deprecated';
1265    use MyMod::Abc;
1266    ...
1267    MyMod::Abc::open($filename);
1268
1269Either the C<warnings::warn> or C<warnings::warnif> function should be
1270used to actually display the warnings message.  This is because they can
1271make use of the feature that allows warnings to be escalated into fatal
1272errors.  So in this case
1273
1274    use MyMod::Abc;
1275    use warnings FATAL => 'MyMod::Abc';
1276    ...
1277    MyMod::Abc::open('../fred.txt');
1278
1279the C<warnings::warnif> function will detect this and die after
1280displaying the warning message.
1281
1282The three warnings functions, C<warnings::warn>, C<warnings::warnif>
1283and C<warnings::enabled> can optionally take an object reference in place
1284of a category name.  In this case the functions will use the class name
1285of the object as the warnings category.
1286
1287Consider this example:
1288
1289    package Original;
1290
1291    no warnings;
1292    use warnings::register;
1293
1294    sub new
1295    {
1296        my $class = shift;
1297        bless [], $class;
1298    }
1299
1300    sub check
1301    {
1302        my $self = shift;
1303        my $value = shift;
1304
1305        if ($value % 2 && warnings::enabled($self))
1306          { warnings::warn($self, "Odd numbers are unsafe") }
1307    }
1308
1309    sub doit
1310    {
1311        my $self = shift;
1312        my $value = shift;
1313        $self->check($value);
1314        # ...
1315    }
1316
1317    1;
1318
1319    package Derived;
1320
1321    use warnings::register;
1322    use Original;
1323    our @ISA = qw( Original );
1324    sub new
1325    {
1326        my $class = shift;
1327        bless [], $class;
1328    }
1329
1330
1331    1;
1332
1333The code below makes use of both modules, but it only enables warnings from
1334C<Derived>.
1335
1336    use Original;
1337    use Derived;
1338    use warnings 'Derived';
1339    my $x = Original->new();
1340    $x->doit(1);
1341    my $y = Derived->new();
1342    $x->doit(1);
1343
1344When this code is run only the C<Derived> object, C<$y>, will generate
1345a warning.
1346
1347    Odd numbers are unsafe at main.pl line 7
1348
1349Notice also that the warning is reported at the line where the object is first
1350used.
1351
1352When registering new categories of warning, you can supply more names to
1353warnings::register like this:
1354
1355    package MyModule;
1356    use warnings::register qw(format precision);
1357
1358    ...
1359
1360    warnings::warnif('MyModule::format', '...');
1361
1362=head1 FUNCTIONS
1363
1364Note: The functions with names ending in C<_at_level> were added in Perl
13655.28.
1366
1367=over 4
1368
1369=item use warnings::register
1370
1371Creates a new warnings category with the same name as the package where
1372the call to the pragma is used.
1373
1374=item warnings::enabled()
1375
1376Use the warnings category with the same name as the current package.
1377
1378Return TRUE if that warnings category is enabled in the calling module.
1379Otherwise returns FALSE.
1380
1381=item warnings::enabled($category)
1382
1383Return TRUE if the warnings category, C<$category>, is enabled in the
1384calling module.
1385Otherwise returns FALSE.
1386
1387=item warnings::enabled($object)
1388
1389Use the name of the class for the object reference, C<$object>, as the
1390warnings category.
1391
1392Return TRUE if that warnings category is enabled in the first scope
1393where the object is used.
1394Otherwise returns FALSE.
1395
1396=item warnings::enabled_at_level($category, $level)
1397
1398Like C<warnings::enabled>, but $level specifies the exact call frame, 0
1399being the immediate caller.
1400
1401=item warnings::fatal_enabled()
1402
1403Return TRUE if the warnings category with the same name as the current
1404package has been set to FATAL in the calling module.
1405Otherwise returns FALSE.
1406
1407=item warnings::fatal_enabled($category)
1408
1409Return TRUE if the warnings category C<$category> has been set to FATAL in
1410the calling module.
1411Otherwise returns FALSE.
1412
1413=item warnings::fatal_enabled($object)
1414
1415Use the name of the class for the object reference, C<$object>, as the
1416warnings category.
1417
1418Return TRUE if that warnings category has been set to FATAL in the first
1419scope where the object is used.
1420Otherwise returns FALSE.
1421
1422=item warnings::fatal_enabled_at_level($category, $level)
1423
1424Like C<warnings::fatal_enabled>, but $level specifies the exact call frame,
14250 being the immediate caller.
1426
1427=item warnings::warn($message)
1428
1429Print C<$message> to STDERR.
1430
1431Use the warnings category with the same name as the current package.
1432
1433If that warnings category has been set to "FATAL" in the calling module
1434then die. Otherwise return.
1435
1436=item warnings::warn($category, $message)
1437
1438Print C<$message> to STDERR.
1439
1440If the warnings category, C<$category>, has been set to "FATAL" in the
1441calling module then die. Otherwise return.
1442
1443=item warnings::warn($object, $message)
1444
1445Print C<$message> to STDERR.
1446
1447Use the name of the class for the object reference, C<$object>, as the
1448warnings category.
1449
1450If that warnings category has been set to "FATAL" in the scope where C<$object>
1451is first used then die. Otherwise return.
1452
1453=item warnings::warn_at_level($category, $level, $message)
1454
1455Like C<warnings::warn>, but $level specifies the exact call frame,
14560 being the immediate caller.
1457
1458=item warnings::warnif($message)
1459
1460Equivalent to:
1461
1462    if (warnings::enabled())
1463      { warnings::warn($message) }
1464
1465=item warnings::warnif($category, $message)
1466
1467Equivalent to:
1468
1469    if (warnings::enabled($category))
1470      { warnings::warn($category, $message) }
1471
1472=item warnings::warnif($object, $message)
1473
1474Equivalent to:
1475
1476    if (warnings::enabled($object))
1477      { warnings::warn($object, $message) }
1478
1479=item warnings::warnif_at_level($category, $level, $message)
1480
1481Like C<warnings::warnif>, but $level specifies the exact call frame,
14820 being the immediate caller.
1483
1484=item warnings::register_categories(@names)
1485
1486This registers warning categories for the given names and is primarily for
1487use by the warnings::register pragma.
1488
1489=back
1490
1491See also L<perlmodlib/Pragmatic Modules> and L<perldiag>.
1492
1493=cut
1494
1495# ex: set ro ft=perl:
1496