X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=warnings.pl;h=df766fea3df58c1e9af37bc99391faac1ab154d3;hb=8bbf3450a1ff0a3996dade29a4194cc0939d871f;hp=b720274e841ca3f7f23ece8f853e294c64c7c5af;hpb=ad5cfffd5b8b7fe37ed57e620649fd13610a07d1;p=p5sagit%2Fp5-mst-13.2.git diff --git a/warnings.pl b/warnings.pl index b720274..df766fe 100644 --- a/warnings.pl +++ b/warnings.pl @@ -1,6 +1,6 @@ #!/usr/bin/perl -$VERSION = '1.01'; +$VERSION = '1.02'; BEGIN { push @INC, './lib'; @@ -414,7 +414,7 @@ while () { #$list{'all'} = [ $offset .. 8 * ($warn_size/2) - 1 ] ; $last_ver = 0; -print PM "%Offsets = (\n" ; +print PM "our %Offsets = (\n" ; foreach my $k (sort { $a <=> $b } keys %ValueToName) { my ($name, $version) = @{ $ValueToName{$k} }; $name = lc $name; @@ -430,7 +430,7 @@ foreach my $k (sort { $a <=> $b } keys %ValueToName) { print PM " );\n\n" ; -print PM "%Bits = (\n" ; +print PM "our %Bits = (\n" ; foreach $k (sort keys %list) { my $v = $list{$k} ; @@ -444,7 +444,7 @@ foreach $k (sort keys %list) { print PM " );\n\n" ; -print PM "%DeadBits = (\n" ; +print PM "our %DeadBits = (\n" ; foreach $k (sort keys %list) { my $v = $list{$k} ; @@ -475,7 +475,7 @@ __END__ package warnings; -our $VERSION = '1.02'; +our $VERSION = '1.03'; =head1 NAME @@ -508,6 +508,10 @@ warnings - Perl pragma to control optional warnings =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. @@ -596,7 +600,7 @@ See L and L. =cut -use Carp ; +use Carp (); KEYWORDS @@ -605,7 +609,7 @@ $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ; sub Croaker { delete $Carp::CarpInternal{'warnings'}; - croak(@_); + Carp::croak(@_); } sub bits @@ -743,17 +747,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])") @@ -774,10 +779,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 @@ -793,11 +798,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;