[perl5.git] / lib / warnings.pm


# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
# This file was created by warnings.pl
# Any changes made here will be lost.
#

package warnings;

our $VERSION = '1.04';

=head1 NAME

warnings - Perl pragma to control optional warnings

=head1 SYNOPSIS

    use warnings;
    no warnings;

    use warnings "all";
    no warnings "all";

    use warnings::register;
    if (warnings::enabled()) {
        warnings::warn("some warning");
    }

    if (warnings::enabled("void")) {
        warnings::warn("void", "some warning");
    }

    if (warnings::enabled($object)) {
        warnings::warn($object, "some warning");
    }

    warnings::warnif("some warning");
    warnings::warnif("void", "some warning");
    warnings::warnif($object, "some warning");

=head1 DESCRIPTION

The C<warnings> 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<perllexwarn> for more information.

If no import list is supplied, all possible warnings are either enabled
or disabled.

A number of functions are provided to assist module authors.

=over 4

=item use warnings::register

Creates a new warnings category with the same name as the package where
the call to the pragma is used.

=item warnings::enabled()

Use the warnings category with the same name as the current package.

Return TRUE if that warnings category is enabled in the calling module.
Otherwise returns FALSE.

=item warnings::enabled($category)

Return TRUE if the warnings category, C<$category>, is enabled in the
calling module.
Otherwise returns FALSE.

=item warnings::enabled($object)

Use the name of the class for the object reference, C<$object>, as the
warnings category.

Return TRUE if that warnings category is enabled in the first scope
where the object is used.
Otherwise returns FALSE.

=item warnings::warn($message)

Print C<$message> to STDERR.

Use the warnings category with the same name as the current package.

If that warnings category has been set to "FATAL" in the calling module
then die. Otherwise return.

=item warnings::warn($category, $message)

Print C<$message> to STDERR.

If the warnings category, C<$category>, has been set to "FATAL" in the
calling module then die. Otherwise return.

=item warnings::warn($object, $message)

Print C<$message> to STDERR.

Use the name of the class for the object reference, C<$object>, as the
warnings category.

If that warnings category has been set to "FATAL" in the scope where C<$object>
is first used then die. Otherwise return.


=item warnings::warnif($message)

Equivalent to:

    if (warnings::enabled())
      { warnings::warn($message) }

=item warnings::warnif($category, $message)

Equivalent to:

    if (warnings::enabled($category))
      { warnings::warn($category, $message) }

=item warnings::warnif($object, $message)

Equivalent to:

    if (warnings::enabled($object))
      { warnings::warn($object, $message) }

=back

See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.

=cut

our %Offsets = (

    # Warnings Categories added in Perl 5.008

    'all'		=> 0,
    'closure'		=> 2,
    '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,
  );

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\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]
  );

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\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 = 96 ;
$BYTES    = 12 ;

$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;

sub Croaker
{
    require Carp;
    delete $Carp::CarpInternal{'warnings'};
    Carp::croak(@_);
}

sub bits
{
    # called from B::Deparse.pm

    push @_, 'all' unless @_;

    my $mask;
    my $catmask ;
    my $fatal = 0 ;
    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
          { Croaker("Unknown warnings category '$word'")}
    }

    return $mask ;
}

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);
    }
    
    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 
{
    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);
    }

    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 ;
    my $offset ;
    my $isobj = 0 ;

    if (@_) {
        # check the category supplied.
        $category = shift ;
        if (my $type = ref $category) {
            Croaker("not an object")
                if exists $builtin_type{$type};
	    $category = $type;
            $isobj = 1 ;
        }
        $offset = $Offsets{$category};
        Croaker("Unknown warnings category '$category'")
	    unless defined $offset;
    }
    else {
        $category = (caller(1))[0] ;
        $offset = $Offsets{$category};
        Croaker("package '$category' not registered for warnings")
	    unless defined $offset ;
    }

    my $this_pkg = (caller(1))[0] ;
    my $i = 2 ;
    my $pkg ;

    if ($isobj) {
        while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
            last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
        }
	$i -= 2 ;
    }
    else {
        $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])")
	unless @_ == 1 || @_ == 0 ;

    my ($callers_bitmask, $offset, $i) = __chk(@_) ;

    return 0 unless defined $callers_bitmask ;
    return vec($callers_bitmask, $offset, 1) ||
           vec($callers_bitmask, $Offsets{'all'}, 1) ;
}


sub warn
{
    Croaker("Usage: warnings::warn([category,] 'message')")
	unless @_ == 2 || @_ == 1 ;

    my $message = pop ;
    my ($callers_bitmask, $offset, $i) = __chk(@_) ;
    require Carp;
    Carp::croak($message)
	if vec($callers_bitmask, $offset+1, 1) ||
	   vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
    Carp::carp($message) ;
}

sub warnif
{
    Croaker("Usage: warnings::warnif([category,] 'message')")
	unless @_ == 2 || @_ == 1 ;

    my $message = pop ;
    my ($callers_bitmask, $offset, $i) = __chk(@_) ;

    return
        unless defined $callers_bitmask &&
            	(vec($callers_bitmask, $offset, 1) ||
            	vec($callers_bitmask, $Offsets{'all'}, 1)) ;

    require Carp;
    Carp::croak($message)
	if vec($callers_bitmask, $offset+1, 1) ||
	   vec($callers_bitmask, $Offsets{'all'}+1, 1) ;

    Carp::carp($message) ;
}

1;
Commit	Line	Data
599cee73	1
38875929	2	# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
4438c4b7	3	# This file was created by warnings.pl
599cee73 PM	4	# Any changes made here will be lost.
	5	#
	6
4438c4b7	7	package warnings;
599cee73	8
09e96b99	9	our $VERSION = '1.04';
0ca4541c	10
599cee73 PM	11	=head1 NAME
599cee73 PM	12
4438c4b7	13	warnings - Perl pragma to control optional warnings
599cee73 PM	14
	15	=head1 SYNOPSIS
	16
4438c4b7 JH	17	use warnings;
4438c4b7 JH	18	no warnings;
599cee73	19
4438c4b7 JH	20	use warnings "all";
4438c4b7 JH	21	no warnings "all";
599cee73	22
d3a7d8c7 GS	23	use warnings::register;
	24	if (warnings::enabled()) {
	25	warnings::warn("some warning");
	26	}
	27
	28	if (warnings::enabled("void")) {
e476b1b5 GS	29	warnings::warn("void", "some warning");
	30	}
	31
7e6d00f8 PM	32	if (warnings::enabled($object)) {
	33	warnings::warn($object, "some warning");
	34	}
	35
721f911b PM	36	warnings::warnif("some warning");
	37	warnings::warnif("void", "some warning");
	38	warnings::warnif($object, "some warning");
7e6d00f8	39
599cee73 PM	40	=head1 DESCRIPTION
599cee73 PM	41
fe2e802c EM	42	The C<warnings> pragma is a replacement for the command line flag C<-w>,
	43	but the pragma is limited to the enclosing block, while the flag is global.
	44	See L<perllexwarn> for more information.
	45
0453d815 PM	46	If no import list is supplied, all possible warnings are either enabled
0453d815 PM	47	or disabled.
599cee73	48
0ca4541c	49	A number of functions are provided to assist module authors.
e476b1b5 GS	50
	51	=over 4
	52
d3a7d8c7 GS	53	=item use warnings::register
d3a7d8c7 GS	54
7e6d00f8 PM	55	Creates a new warnings category with the same name as the package where
	56	the call to the pragma is used.
	57
	58	=item warnings::enabled()
	59
	60	Use the warnings category with the same name as the current package.
	61
	62	Return TRUE if that warnings category is enabled in the calling module.
	63	Otherwise returns FALSE.
	64
	65	=item warnings::enabled($category)
	66
	67	Return TRUE if the warnings category, C<$category>, is enabled in the
	68	calling module.
	69	Otherwise returns FALSE.
	70
	71	=item warnings::enabled($object)
	72
	73	Use the name of the class for the object reference, C<$object>, as the
	74	warnings category.
	75
	76	Return TRUE if that warnings category is enabled in the first scope
	77	where the object is used.
	78	Otherwise returns FALSE.
	79
	80	=item warnings::warn($message)
	81
	82	Print C<$message> to STDERR.
	83
	84	Use the warnings category with the same name as the current package.
	85
	86	If that warnings category has been set to "FATAL" in the calling module
	87	then die. Otherwise return.
	88
	89	=item warnings::warn($category, $message)
	90
	91	Print C<$message> to STDERR.
	92
	93	If the warnings category, C<$category>, has been set to "FATAL" in the
	94	calling module then die. Otherwise return.
e476b1b5	95
7e6d00f8	96	=item warnings::warn($object, $message)
e476b1b5	97
7e6d00f8	98	Print C<$message> to STDERR.
e476b1b5	99
7e6d00f8 PM	100	Use the name of the class for the object reference, C<$object>, as the
7e6d00f8 PM	101	warnings category.
d3a7d8c7	102
7e6d00f8 PM	103	If that warnings category has been set to "FATAL" in the scope where C<$object>
7e6d00f8 PM	104	is first used then die. Otherwise return.
599cee73	105
e476b1b5	106
7e6d00f8 PM	107	=item warnings::warnif($message)
	108
	109	Equivalent to:
	110
	111	if (warnings::enabled())
	112	{ warnings::warn($message) }
	113
	114	=item warnings::warnif($category, $message)
	115
	116	Equivalent to:
	117
	118	if (warnings::enabled($category))
	119	{ warnings::warn($category, $message) }
	120
	121	=item warnings::warnif($object, $message)
	122
	123	Equivalent to:
	124
	125	if (warnings::enabled($object))
	126	{ warnings::warn($object, $message) }
d3a7d8c7	127
e476b1b5 GS	128	=back
e476b1b5 GS	129
749f83fa	130	See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
599cee73 PM	131
	132	=cut
	133
53c33732	134	our %Offsets = (
0d658bf5 PM	135
	136	# Warnings Categories added in Perl 5.008
	137
d3a7d8c7	138	'all' => 0,
3eae5ce4	139	'closure' => 2,
12bcd1a6 PM	140	'deprecated' => 4,
	141	'exiting' => 6,
	142	'glob' => 8,
	143	'io' => 10,
	144	'closed' => 12,
	145	'exec' => 14,
99ef548b PM	146	'layer' => 16,
	147	'newline' => 18,
	148	'pipe' => 20,
	149	'unopened' => 22,
	150	'misc' => 24,
	151	'numeric' => 26,
	152	'once' => 28,
	153	'overflow' => 30,
	154	'pack' => 32,
	155	'portable' => 34,
	156	'recursion' => 36,
	157	'redefine' => 38,
	158	'regexp' => 40,
	159	'severe' => 42,
	160	'debugging' => 44,
	161	'inplace' => 46,
	162	'internal' => 48,
	163	'malloc' => 50,
	164	'signal' => 52,
	165	'substr' => 54,
	166	'syntax' => 56,
	167	'ambiguous' => 58,
	168	'bareword' => 60,
	169	'digit' => 62,
	170	'parenthesis' => 64,
	171	'precedence' => 66,
	172	'printf' => 68,
	173	'prototype' => 70,
	174	'qw' => 72,
	175	'reserved' => 74,
	176	'semicolon' => 76,
	177	'taint' => 78,
38875929 DM	178	'threads' => 80,
	179	'uninitialized' => 82,
	180	'unpack' => 84,
	181	'untie' => 86,
	182	'utf8' => 88,
	183	'void' => 90,
	184	'y2k' => 92,
8fa7688f SF	185
	186	# Warnings Categories added in Perl 5.009
	187
	188	'assertions' => 94,
d3a7d8c7 GS	189	);
d3a7d8c7 GS	190
53c33732	191	our %Bits = (
8fa7688f	192	'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..47]
99ef548b	193	'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
8fa7688f	194	'assertions' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [47]
99ef548b	195	'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
12bcd1a6	196	'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
3eae5ce4	197	'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
99ef548b	198	'debugging' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
12bcd1a6	199	'deprecated' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
99ef548b	200	'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
12bcd1a6 PM	201	'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
	202	'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
	203	'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
99ef548b PM	204	'inplace' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
	205	'internal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
	206	'io' => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
	207	'layer' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
	208	'malloc' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
	209	'misc' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
	210	'newline' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
	211	'numeric' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
	212	'once' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
	213	'overflow' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
	214	'pack' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
	215	'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
	216	'pipe' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
	217	'portable' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
	218	'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
	219	'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
	220	'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
	221	'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
	222	'recursion' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
	223	'redefine' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19]
	224	'regexp' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
	225	'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
	226	'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
	227	'severe' => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00", # [21..25]
	228	'signal' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
	229	'substr' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
	230	'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x00", # [28..38]
	231	'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
38875929 DM	232	'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
38875929 DM	233	'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
99ef548b	234	'unopened' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
38875929 DM	235	'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
	236	'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
	237	'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
	238	'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
	239	'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
599cee73 PM	240	);
599cee73 PM	241
53c33732	242	our %DeadBits = (
8fa7688f	243	'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..47]
99ef548b	244	'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
8fa7688f	245	'assertions' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [47]
99ef548b	246	'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
12bcd1a6	247	'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
3eae5ce4	248	'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
99ef548b	249	'debugging' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
12bcd1a6	250	'deprecated' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
99ef548b	251	'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
12bcd1a6 PM	252	'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
	253	'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
	254	'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
99ef548b PM	255	'inplace' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
	256	'internal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
	257	'io' => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
	258	'layer' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
	259	'malloc' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
	260	'misc' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
	261	'newline' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
	262	'numeric' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
	263	'once' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
	264	'overflow' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
	265	'pack' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
	266	'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
	267	'pipe' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
	268	'portable' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
	269	'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
	270	'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
	271	'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
	272	'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
	273	'recursion' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
	274	'redefine' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19]
	275	'regexp' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
	276	'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
	277	'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
	278	'severe' => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00", # [21..25]
	279	'signal' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
	280	'substr' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
	281	'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x00", # [28..38]
	282	'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
38875929 DM	283	'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
38875929 DM	284	'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
99ef548b	285	'unopened' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
38875929 DM	286	'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
	287	'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
	288	'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
	289	'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
	290	'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46]
599cee73 PM	291	);
599cee73 PM	292
a86a20aa	293	$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
8fa7688f	294	$LAST_BIT = 96 ;
a86a20aa	295	$BYTES = 12 ;
d3a7d8c7 GS	296
d3a7d8c7 GS	297	$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
599cee73	298
c3186b65 PM	299	sub Croaker
c3186b65 PM	300	{
09e96b99	301	require Carp;
c3186b65	302	delete $Carp::CarpInternal{'warnings'};
8becbb3b	303	Carp::croak(@_);
c3186b65 PM	304	}
c3186b65 PM	305
6e9af7e4 PM	306	sub bits
	307	{
	308	# called from B::Deparse.pm
	309
	310	push @_, 'all' unless @_;
	311
	312	my $mask;
599cee73 PM	313	my $catmask ;
599cee73 PM	314	my $fatal = 0 ;
6e9af7e4 PM	315	my $no_fatal = 0 ;
	316
	317	foreach my $word ( @_ ) {
	318	if ($word eq 'FATAL') {
327afb7f	319	$fatal = 1;
6e9af7e4 PM	320	$no_fatal = 0;
	321	}
	322	elsif ($word eq 'NONFATAL') {
	323	$fatal = 0;
	324	$no_fatal = 1;
327afb7f	325	}
d3a7d8c7 GS	326	elsif ($catmask = $Bits{$word}) {
	327	$mask \|= $catmask ;
	328	$mask \|= $DeadBits{$word} if $fatal ;
6e9af7e4	329	$mask &= ~($DeadBits{$word}\|$All) if $no_fatal ;
599cee73	330	}
d3a7d8c7	331	else
c3186b65	332	{ Croaker("Unknown warnings category '$word'")}
599cee73 PM	333	}
	334
	335	return $mask ;
	336	}
	337
6e9af7e4 PM	338	sub import
6e9af7e4 PM	339	{
599cee73	340	shift;
6e9af7e4 PM	341
	342	my $catmask ;
	343	my $fatal = 0 ;
	344	my $no_fatal = 0 ;
	345
f1f33818	346	my $mask = ${^WARNING_BITS} ;
6e9af7e4	347
f1f33818 PM	348	if (vec($mask, $Offsets{'all'}, 1)) {
	349	$mask \|= $Bits{'all'} ;
	350	$mask \|= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
	351	}
6e9af7e4 PM	352
	353	push @_, 'all' unless @_;
	354
	355	foreach my $word ( @_ ) {
	356	if ($word eq 'FATAL') {
	357	$fatal = 1;
	358	$no_fatal = 0;
	359	}
	360	elsif ($word eq 'NONFATAL') {
	361	$fatal = 0;
	362	$no_fatal = 1;
	363	}
	364	elsif ($catmask = $Bits{$word}) {
	365	$mask \|= $catmask ;
	366	$mask \|= $DeadBits{$word} if $fatal ;
	367	$mask &= ~($DeadBits{$word}\|$All) if $no_fatal ;
	368	}
	369	else
	370	{ Croaker("Unknown warnings category '$word'")}
	371	}
	372
	373	${^WARNING_BITS} = $mask ;
599cee73 PM	374	}
599cee73 PM	375
6e9af7e4 PM	376	sub unimport
6e9af7e4 PM	377	{
599cee73	378	shift;
6e9af7e4 PM	379
6e9af7e4 PM	380	my $catmask ;
d3a7d8c7	381	my $mask = ${^WARNING_BITS} ;
6e9af7e4	382
d3a7d8c7	383	if (vec($mask, $Offsets{'all'}, 1)) {
f1f33818	384	$mask \|= $Bits{'all'} ;
d3a7d8c7 GS	385	$mask \|= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
d3a7d8c7 GS	386	}
6e9af7e4 PM	387
	388	push @_, 'all' unless @_;
	389
	390	foreach my $word ( @_ ) {
	391	if ($word eq 'FATAL') {
	392	next;
	393	}
	394	elsif ($catmask = $Bits{$word}) {
	395	$mask &= ~($catmask \| $DeadBits{$word} \| $All);
	396	}
	397	else
	398	{ Croaker("Unknown warnings category '$word'")}
	399	}
	400
	401	${^WARNING_BITS} = $mask ;
599cee73 PM	402	}
599cee73 PM	403
9df0f64f MK	404	my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
9df0f64f MK	405
7e6d00f8	406	sub __chk
599cee73	407	{
d3a7d8c7 GS	408	my $category ;
d3a7d8c7 GS	409	my $offset ;
7e6d00f8	410	my $isobj = 0 ;
d3a7d8c7 GS	411
	412	if (@_) {
	413	# check the category supplied.
	414	$category = shift ;
9df0f64f MK	415	if (my $type = ref $category) {
	416	Croaker("not an object")
	417	if exists $builtin_type{$type};
	418	$category = $type;
7e6d00f8 PM	419	$isobj = 1 ;
7e6d00f8 PM	420	}
d3a7d8c7	421	$offset = $Offsets{$category};
c3186b65	422	Croaker("Unknown warnings category '$category'")
d3a7d8c7 GS	423	unless defined $offset;
	424	}
	425	else {
0ca4541c	426	$category = (caller(1))[0] ;
d3a7d8c7	427	$offset = $Offsets{$category};
c3186b65	428	Croaker("package '$category' not registered for warnings")
d3a7d8c7 GS	429	unless defined $offset ;
	430	}
	431
0ca4541c	432	my $this_pkg = (caller(1))[0] ;
7e6d00f8 PM	433	my $i = 2 ;
	434	my $pkg ;
	435
	436	if ($isobj) {
	437	while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
	438	last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
	439	}
	440	$i -= 2 ;
	441	}
	442	else {
4f527b71	443	$i = _error_loc(); # see where Carp will allocate the error
7e6d00f8 PM	444	}
7e6d00f8 PM	445
0ca4541c	446	my $callers_bitmask = (caller($i))[9] ;
7e6d00f8 PM	447	return ($callers_bitmask, $offset, $i) ;
	448	}
	449
4f527b71 AS	450	sub _error_loc {
	451	require Carp::Heavy;
	452	goto &Carp::short_error_loc; # don't introduce another stack frame
	453	}
	454
7e6d00f8 PM	455	sub enabled
7e6d00f8 PM	456	{
c3186b65	457	Croaker("Usage: warnings::enabled([category])")
7e6d00f8 PM	458	unless @_ == 1 \|\| @_ == 0 ;
	459
	460	my ($callers_bitmask, $offset, $i) = __chk(@_) ;
	461
	462	return 0 unless defined $callers_bitmask ;
d3a7d8c7 GS	463	return vec($callers_bitmask, $offset, 1) \|\|
d3a7d8c7 GS	464	vec($callers_bitmask, $Offsets{'all'}, 1) ;
599cee73 PM	465	}
599cee73 PM	466
d3a7d8c7	467
e476b1b5 GS	468	sub warn
e476b1b5 GS	469	{
c3186b65	470	Croaker("Usage: warnings::warn([category,] 'message')")
d3a7d8c7	471	unless @_ == 2 \|\| @_ == 1 ;
d3a7d8c7	472
7e6d00f8 PM	473	my $message = pop ;
7e6d00f8 PM	474	my ($callers_bitmask, $offset, $i) = __chk(@_) ;
09e96b99	475	require Carp;
8becbb3b	476	Carp::croak($message)
d3a7d8c7 GS	477	if vec($callers_bitmask, $offset+1, 1) \|\|
d3a7d8c7 GS	478	vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
8becbb3b	479	Carp::carp($message) ;
e476b1b5 GS	480	}
e476b1b5 GS	481
7e6d00f8 PM	482	sub warnif
7e6d00f8 PM	483	{
c3186b65	484	Croaker("Usage: warnings::warnif([category,] 'message')")
7e6d00f8 PM	485	unless @_ == 2 \|\| @_ == 1 ;
	486
	487	my $message = pop ;
	488	my ($callers_bitmask, $offset, $i) = __chk(@_) ;
7e6d00f8	489
0ca4541c	490	return
7e6d00f8 PM	491	unless defined $callers_bitmask &&
	492	(vec($callers_bitmask, $offset, 1) \|\|
	493	vec($callers_bitmask, $Offsets{'all'}, 1)) ;
	494
09e96b99	495	require Carp;
8becbb3b	496	Carp::croak($message)
7e6d00f8 PM	497	if vec($callers_bitmask, $offset+1, 1) \|\|
	498	vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
	499
8becbb3b	500	Carp::carp($message) ;
7e6d00f8	501	}
0d658bf5	502
599cee73	503	1;