diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/warnings.pm | 33 | ||||
| -rw-r--r-- | lib/warnings/register.pm | 17 |
2 files changed, 40 insertions, 10 deletions
diff --git a/lib/warnings.pm b/lib/warnings.pm index eedbc3285b..e01027e614 100644 --- a/lib/warnings.pm +++ b/lib/warnings.pm @@ -153,6 +153,12 @@ Equivalent to: if (warnings::enabled($object)) { warnings::warn($object, $message) } + +=item warnings::register(@names) + +This registers warning categories for the given names and is primarily for +use by the warnings::register pragma, for which see L<perllexwarn>. + =back See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>. @@ -490,6 +496,33 @@ sub __chk Carp::carp($message); } +sub _mkMask +{ + my ($bit) = @_; + my $mask = ""; + + vec($mask, $bit, 1) = 1; + return $mask; +} + +sub register +{ + my @names = @_; + + for my $name (@names) { + if (! defined $Bits{$name}) { + $Bits{$name} = _mkMask($LAST_BIT); + vec($Bits{'all'}, $LAST_BIT, 1) = 1; + $Offsets{$name} = $LAST_BIT ++; + foreach my $k (keys %Bits) { + vec($Bits{$k}, $LAST_BIT, 1) = 0; + } + $DeadBits{$name} = _mkMask($LAST_BIT); + vec($DeadBits{'all'}, $LAST_BIT++, 1) = 1; + } + } +} + sub _error_loc { require Carp; goto &Carp::short_error_loc; # don't introduce another stack frame diff --git a/lib/warnings/register.pm b/lib/warnings/register.pm index 57c865df52..4cf93b29ec 100644 --- a/lib/warnings/register.pm +++ b/lib/warnings/register.pm @@ -23,6 +23,8 @@ usage. require warnings; +# left here as cruft in case other users were using this undocumented routine +# -- rjbs, 2010-09-08 sub mkMask { my ($bit) = @_; @@ -35,17 +37,12 @@ sub mkMask sub import { shift; + my @categories = @_; + my $package = (caller(0))[0]; - if (! defined $warnings::Bits{$package}) { - $warnings::Bits{$package} = mkMask($warnings::LAST_BIT); - vec($warnings::Bits{'all'}, $warnings::LAST_BIT, 1) = 1; - $warnings::Offsets{$package} = $warnings::LAST_BIT ++; - foreach my $k (keys %warnings::Bits) { - vec($warnings::Bits{$k}, $warnings::LAST_BIT, 1) = 0; - } - $warnings::DeadBits{$package} = mkMask($warnings::LAST_BIT); - vec($warnings::DeadBits{'all'}, $warnings::LAST_BIT++, 1) = 1; - } + warnings::register($package); + + warnings::register($package . "::$_") for @categories; } 1; |