X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fwarnings.pm;h=32f020eb9426660251a81c98e2e24c078aedd51a;hb=5dca256ec738057dc331fb644a93eca44ad5fa14;hp=6b46e357290bd2b5a69c986a26445bfd5b9fdf45;hpb=08540116c788d6f1e67757a00e334989e55f0cfc;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/warnings.pm b/lib/warnings.pm index 6b46e35..32f020e 100644 --- a/lib/warnings.pm +++ b/lib/warnings.pm @@ -1,11 +1,12 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! # This file was created by warnings.pl # Any changes made here will be lost. # package warnings; -our $VERSION = '1.00'; +our $VERSION = '1.03'; =head1 NAME @@ -32,12 +33,16 @@ warnings - Perl pragma to control optional warnings warnings::warn($object, "some warning"); } - warnif("some warning"); - warnif("void", "some warning"); - warnif($object, "some warning"); + warnings::warnif("some warning"); + warnings::warnif("void", "some warning"); + warnings::warnif($object, "some warning"); =head1 DESCRIPTION +The C pragma is a replacement for the command line flag C<-w>, +but the pragma is limited to the enclosing block, while the flag is global. +See L for more information. + If no import list is supplied, all possible warnings are either enabled or disabled. @@ -126,197 +131,279 @@ See L and L. =cut -use Carp ; +use Carp (); + +our %Offsets = ( + + # Warnings Categories added in Perl 5.008 -%Offsets = ( 'all' => 0, 'closure' => 2, - 'exiting' => 4, - 'glob' => 6, - 'io' => 8, - 'closed' => 10, - 'exec' => 12, - 'newline' => 14, - 'pipe' => 16, - 'unopened' => 18, - 'misc' => 20, - 'numeric' => 22, - 'once' => 24, - 'overflow' => 26, - 'pack' => 28, - 'portable' => 30, - 'recursion' => 32, - 'redefine' => 34, - 'regexp' => 36, - 'severe' => 38, - 'debugging' => 40, - 'inplace' => 42, - 'internal' => 44, - 'malloc' => 46, - 'signal' => 48, - 'substr' => 50, - 'syntax' => 52, - 'ambiguous' => 54, - 'bareword' => 56, - 'deprecated' => 58, - 'digit' => 60, - 'parenthesis' => 62, - 'precedence' => 64, - 'printf' => 66, - 'prototype' => 68, - 'qw' => 70, - 'reserved' => 72, - 'semicolon' => 74, - 'taint' => 76, - 'uninitialized' => 78, - 'unpack' => 80, - 'untie' => 82, - 'utf8' => 84, - 'void' => 86, - 'y2k' => 88, + 'deprecated' => 4, + 'exiting' => 6, + 'glob' => 8, + 'io' => 10, + 'closed' => 12, + 'exec' => 14, + 'layer' => 16, + 'newline' => 18, + 'pipe' => 20, + 'unopened' => 22, + 'misc' => 24, + 'numeric' => 26, + 'once' => 28, + 'overflow' => 30, + 'pack' => 32, + 'portable' => 34, + 'recursion' => 36, + 'redefine' => 38, + 'regexp' => 40, + 'severe' => 42, + 'debugging' => 44, + 'inplace' => 46, + 'internal' => 48, + 'malloc' => 50, + 'signal' => 52, + 'substr' => 54, + 'syntax' => 56, + 'ambiguous' => 58, + 'bareword' => 60, + 'digit' => 62, + 'parenthesis' => 64, + 'precedence' => 66, + 'printf' => 68, + 'prototype' => 70, + 'qw' => 72, + 'reserved' => 74, + 'semicolon' => 76, + 'taint' => 78, + 'threads' => 80, + 'uninitialized' => 82, + 'unpack' => 84, + 'untie' => 86, + 'utf8' => 88, + 'void' => 90, + 'y2k' => 92, + + # Warnings Categories added in Perl 5.009 + + 'assertions' => 94, ); -%Bits = ( - 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x01", # [0..44] - 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27] - 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [28] - 'closed' => "\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5] +our %Bits = ( + 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..47] + 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29] + 'assertions' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [47] + 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30] + 'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6] 'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1] - 'debugging' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20] - 'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29] - 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30] - 'exec' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6] - 'exiting' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2] - 'glob' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3] - 'inplace' => "\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [21] - 'internal' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22] - 'io' => "\x00\x55\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9] - 'malloc' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23] - 'misc' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10] - 'newline' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7] - 'numeric' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11] - 'once' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12] - 'overflow' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13] - 'pack' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14] - 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31] - 'pipe' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8] - 'portable' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15] - 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32] - 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33] - 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34] - 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35] - 'recursion' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16] - 'redefine' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17] - 'regexp' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18] - 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36] - 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37] - 'severe' => "\x00\x00\x00\x00\x40\x55\x00\x00\x00\x00\x00\x00", # [19..23] - 'signal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24] - 'substr' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25] - 'syntax' => "\x00\x00\x00\x00\x00\x00\x50\x55\x55\x05\x00\x00", # [26..37] - 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38] - 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39] - 'unopened' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9] - 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40] - 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41] - 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42] - 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43] - 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44] + 'debugging' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22] + 'deprecated' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2] + 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31] + 'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7] + 'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3] + 'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4] + 'inplace' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23] + 'internal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24] + 'io' => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11] + 'layer' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8] + 'malloc' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25] + 'misc' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12] + 'newline' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9] + 'numeric' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13] + 'once' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14] + 'overflow' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15] + 'pack' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16] + 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32] + 'pipe' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10] + 'portable' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17] + 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33] + 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34] + 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35] + 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36] + 'recursion' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18] + 'redefine' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19] + 'regexp' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20] + 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37] + 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38] + 'severe' => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00", # [21..25] + 'signal' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26] + 'substr' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27] + 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x00", # [28..38] + 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39] + 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40] + 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41] + 'unopened' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11] + 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42] + 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43] + 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44] + 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45] + 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46] ); -%DeadBits = ( - 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x02", # [0..44] - 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27] - 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [28] - 'closed' => "\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5] +our %DeadBits = ( + 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..47] + 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29] + 'assertions' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [47] + 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30] + 'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6] 'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1] - 'debugging' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20] - 'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29] - 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30] - 'exec' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6] - 'exiting' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2] - 'glob' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3] - 'inplace' => "\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [21] - 'internal' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22] - 'io' => "\x00\xaa\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9] - 'malloc' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23] - 'misc' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10] - 'newline' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7] - 'numeric' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11] - 'once' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12] - 'overflow' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13] - 'pack' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14] - 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31] - 'pipe' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8] - 'portable' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15] - 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32] - 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33] - 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34] - 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35] - 'recursion' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16] - 'redefine' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17] - 'regexp' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18] - 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36] - 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37] - 'severe' => "\x00\x00\x00\x00\x80\xaa\x00\x00\x00\x00\x00\x00", # [19..23] - 'signal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24] - 'substr' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25] - 'syntax' => "\x00\x00\x00\x00\x00\x00\xa0\xaa\xaa\x0a\x00\x00", # [26..37] - 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38] - 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39] - 'unopened' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9] - 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40] - 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41] - 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42] - 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43] - 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44] + 'debugging' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22] + 'deprecated' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2] + 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31] + 'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7] + 'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3] + 'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4] + 'inplace' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23] + 'internal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24] + 'io' => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11] + 'layer' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8] + 'malloc' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25] + 'misc' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12] + 'newline' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9] + 'numeric' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13] + 'once' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14] + 'overflow' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15] + 'pack' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16] + 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32] + 'pipe' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10] + 'portable' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17] + 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33] + 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34] + 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35] + 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36] + 'recursion' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18] + 'redefine' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19] + 'regexp' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20] + 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37] + 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38] + 'severe' => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00", # [21..25] + 'signal' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26] + 'substr' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27] + 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x00", # [28..38] + 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39] + 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40] + 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41] + 'unopened' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11] + 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42] + 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43] + 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44] + 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45] + 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46] ); $NONE = "\0\0\0\0\0\0\0\0\0\0\0\0"; -$LAST_BIT = 90 ; +$LAST_BIT = 96 ; $BYTES = 12 ; $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ; -sub bits { - my $mask ; +sub Croaker +{ + delete $Carp::CarpInternal{'warnings'}; + Carp::croak(@_); +} + +sub bits +{ + # called from B::Deparse.pm + + push @_, 'all' unless @_; + + my $mask; my $catmask ; my $fatal = 0 ; - foreach my $word (@_) { - if ($word eq 'FATAL') { + my $no_fatal = 0 ; + + foreach my $word ( @_ ) { + if ($word eq 'FATAL') { $fatal = 1; + $no_fatal = 0; + } + elsif ($word eq 'NONFATAL') { + $fatal = 0; + $no_fatal = 1; } elsif ($catmask = $Bits{$word}) { $mask |= $catmask ; $mask |= $DeadBits{$word} if $fatal ; + $mask &= ~($DeadBits{$word}|$All) if $no_fatal ; } else - { croak("unknown warnings category '$word'")} + { Croaker("Unknown warnings category '$word'")} } return $mask ; } -sub import { +sub import +{ shift; + + my $catmask ; + my $fatal = 0 ; + my $no_fatal = 0 ; + my $mask = ${^WARNING_BITS} ; + if (vec($mask, $Offsets{'all'}, 1)) { $mask |= $Bits{'all'} ; $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1); } - ${^WARNING_BITS} = $mask | bits(@_ ? @_ : 'all') ; + + push @_, 'all' unless @_; + + foreach my $word ( @_ ) { + if ($word eq 'FATAL') { + $fatal = 1; + $no_fatal = 0; + } + elsif ($word eq 'NONFATAL') { + $fatal = 0; + $no_fatal = 1; + } + elsif ($catmask = $Bits{$word}) { + $mask |= $catmask ; + $mask |= $DeadBits{$word} if $fatal ; + $mask &= ~($DeadBits{$word}|$All) if $no_fatal ; + } + else + { Croaker("Unknown warnings category '$word'")} + } + + ${^WARNING_BITS} = $mask ; } -sub unimport { +sub unimport +{ shift; + + my $catmask ; my $mask = ${^WARNING_BITS} ; + if (vec($mask, $Offsets{'all'}, 1)) { $mask |= $Bits{'all'} ; $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1); } - ${^WARNING_BITS} = $mask & ~ (bits('FATAL' => (@_ ? @_ : 'all')) | $All) ; + + push @_, 'all' unless @_; + + foreach my $word ( @_ ) { + if ($word eq 'FATAL') { + next; + } + elsif ($catmask = $Bits{$word}) { + $mask &= ~($catmask | $DeadBits{$word} | $All); + } + else + { Croaker("Unknown warnings category '$word'")} + } + + ${^WARNING_BITS} = $mask ; } +my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = (); + sub __chk { my $category ; @@ -326,20 +413,20 @@ sub __chk if (@_) { # check the category supplied. $category = shift ; - if (ref $category) { - croak ("not an object") - if $category !~ /^([^=]+)=/ ;+ - $category = $1 ; + if (my $type = ref $category) { + Croaker("not an object") + if exists $builtin_type{$type}; + $category = $type; $isobj = 1 ; } $offset = $Offsets{$category}; - croak("unknown warnings category '$category'") + Croaker("Unknown warnings category '$category'") unless defined $offset; } else { $category = (caller(1))[0] ; $offset = $Offsets{$category}; - croak("package '$category' not registered for warnings") + Croaker("package '$category' not registered for warnings") unless defined $offset ; } @@ -354,20 +441,21 @@ sub __chk $i -= 2 ; } else { - for ($i = 2 ; $pkg = (caller($i))[0] ; ++ $i) { - last if $pkg ne $this_pkg ; - } - $i = 2 - if !$pkg || $pkg eq $this_pkg ; + $i = _error_loc(); # see where Carp will allocate the error } my $callers_bitmask = (caller($i))[9] ; return ($callers_bitmask, $offset, $i) ; } +sub _error_loc { + require Carp::Heavy; + goto &Carp::short_error_loc; # don't introduce another stack frame +} + sub enabled { - croak("Usage: warnings::enabled([category])") + Croaker("Usage: warnings::enabled([category])") unless @_ == 1 || @_ == 0 ; my ($callers_bitmask, $offset, $i) = __chk(@_) ; @@ -380,36 +468,35 @@ sub enabled sub warn { - croak("Usage: warnings::warn([category,] 'message')") + Croaker("Usage: warnings::warn([category,] 'message')") unless @_ == 2 || @_ == 1 ; my $message = pop ; my ($callers_bitmask, $offset, $i) = __chk(@_) ; - local $Carp::CarpLevel = $i ; - croak($message) + Carp::croak($message) if vec($callers_bitmask, $offset+1, 1) || vec($callers_bitmask, $Offsets{'all'}+1, 1) ; - carp($message) ; + Carp::carp($message) ; } sub warnif { - croak("Usage: warnings::warnif([category,] 'message')") + Croaker("Usage: warnings::warnif([category,] 'message')") unless @_ == 2 || @_ == 1 ; my $message = pop ; my ($callers_bitmask, $offset, $i) = __chk(@_) ; - local $Carp::CarpLevel = $i ; return unless defined $callers_bitmask && (vec($callers_bitmask, $offset, 1) || vec($callers_bitmask, $Offsets{'all'}, 1)) ; - croak($message) + Carp::croak($message) if vec($callers_bitmask, $offset+1, 1) || vec($callers_bitmask, $Offsets{'all'}+1, 1) ; - carp($message) ; + Carp::carp($message) ; } + 1;