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