X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fwarnings.pm;h=656b7ac49175a64806ee720731c42553d4066281;hb=ef9466ead9a7d468cd27794efe05e08b2c595e6f;hp=705548a97648d81400c50dd13add6c71e9eeeae7;hpb=53610d0bd42b53473db45197fdfabc36caa55679;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/warnings.pm b/lib/warnings.pm index 705548a..656b7ac 100644 --- a/lib/warnings.pm +++ b/lib/warnings.pm @@ -6,7 +6,7 @@ package warnings; -our $VERSION = '1.02'; +our $VERSION = '1.03'; =head1 NAME @@ -131,9 +131,9 @@ See L and L. =cut -use Carp ; +use Carp (); -%Offsets = ( +our %Offsets = ( # Warnings Categories added in Perl 5.008 @@ -190,7 +190,7 @@ use Carp ; 'assertions' => 94, ); -%Bits = ( +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] @@ -241,7 +241,7 @@ use Carp ; 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46] ); -%DeadBits = ( +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] @@ -301,7 +301,7 @@ $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ; sub Croaker { delete $Carp::CarpInternal{'warnings'}; - croak(@_); + Carp::croak(@_); } sub bits @@ -439,17 +439,18 @@ 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 { Croaker("Usage: warnings::enabled([category])") @@ -470,10 +471,10 @@ sub warn my $message = pop ; my ($callers_bitmask, $offset, $i) = __chk(@_) ; - 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 @@ -489,11 +490,11 @@ sub warnif (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;