[perl5.git] / lib / warnings.pm

# -*- buffer-read-only: t -*-
# !!!!!!!   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,

    # Warnings Categories added in Perl 5.009

    'assertions'	=> 92,
  );

our %Bits = (
    'all'		=> "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..46]
    '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\x10", # [46]
    '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]
  );

our %DeadBits = (
    'all'		=> "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..46]
    '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\x20", # [46]
    '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]
  );

$NONE     = "\0\0\0\0\0\0\0\0\0\0\0\0";
$LAST_BIT = 94 ;
$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;
# ex: set ro:
Commit	Line	Data
37442d52	1	# -- buffer-read-only: t --
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,
8fa7688f SF	184
	185	# Warnings Categories added in Perl 5.009
	186
2db3864f	187	'assertions' => 92,
d3a7d8c7 GS	188	);
d3a7d8c7 GS	189
53c33732	190	our %Bits = (
2db3864f	191	'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..46]
99ef548b	192	'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
2db3864f	193	'assertions' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
99ef548b	194	'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
12bcd1a6	195	'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
3eae5ce4	196	'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
99ef548b	197	'debugging' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
12bcd1a6	198	'deprecated' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
99ef548b	199	'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
12bcd1a6 PM	200	'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
	201	'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
	202	'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
99ef548b PM	203	'inplace' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
	204	'internal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
	205	'io' => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
	206	'layer' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
	207	'malloc' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
	208	'misc' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
	209	'newline' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
	210	'numeric' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
	211	'once' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
	212	'overflow' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
	213	'pack' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
	214	'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
	215	'pipe' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
	216	'portable' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
	217	'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
	218	'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
	219	'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
	220	'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
	221	'recursion' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
	222	'redefine' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19]
	223	'regexp' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
	224	'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
	225	'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
	226	'severe' => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00", # [21..25]
	227	'signal' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
	228	'substr' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
	229	'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x00", # [28..38]
	230	'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
38875929 DM	231	'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
38875929 DM	232	'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
99ef548b	233	'unopened' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
38875929 DM	234	'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
	235	'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
	236	'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
	237	'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
599cee73 PM	238	);
599cee73 PM	239
53c33732	240	our %DeadBits = (
2db3864f	241	'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..46]
99ef548b	242	'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
2db3864f	243	'assertions' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46]
99ef548b	244	'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
12bcd1a6	245	'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
3eae5ce4	246	'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
99ef548b	247	'debugging' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
12bcd1a6	248	'deprecated' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
99ef548b	249	'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
12bcd1a6 PM	250	'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
	251	'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
	252	'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
99ef548b PM	253	'inplace' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
	254	'internal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
	255	'io' => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
	256	'layer' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
	257	'malloc' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
	258	'misc' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
	259	'newline' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
	260	'numeric' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
	261	'once' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
	262	'overflow' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
	263	'pack' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
	264	'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
	265	'pipe' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
	266	'portable' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
	267	'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
	268	'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
	269	'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
	270	'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
	271	'recursion' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
	272	'redefine' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19]
	273	'regexp' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
	274	'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
	275	'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
	276	'severe' => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00", # [21..25]
	277	'signal' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
	278	'substr' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
	279	'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x00", # [28..38]
	280	'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
38875929 DM	281	'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
38875929 DM	282	'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
99ef548b	283	'unopened' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
38875929 DM	284	'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
	285	'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
	286	'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
	287	'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
599cee73 PM	288	);
599cee73 PM	289
a86a20aa	290	$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
2db3864f	291	$LAST_BIT = 94 ;
a86a20aa	292	$BYTES = 12 ;
d3a7d8c7 GS	293
d3a7d8c7 GS	294	$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
599cee73	295
c3186b65 PM	296	sub Croaker
c3186b65 PM	297	{
09e96b99	298	require Carp;
c3186b65	299	delete $Carp::CarpInternal{'warnings'};
8becbb3b	300	Carp::croak(@_);
c3186b65 PM	301	}
c3186b65 PM	302
6e9af7e4 PM	303	sub bits
	304	{
	305	# called from B::Deparse.pm
	306
	307	push @_, 'all' unless @_;
	308
	309	my $mask;
599cee73 PM	310	my $catmask ;
599cee73 PM	311	my $fatal = 0 ;
6e9af7e4 PM	312	my $no_fatal = 0 ;
	313
	314	foreach my $word ( @_ ) {
	315	if ($word eq 'FATAL') {
327afb7f	316	$fatal = 1;
6e9af7e4 PM	317	$no_fatal = 0;
	318	}
	319	elsif ($word eq 'NONFATAL') {
	320	$fatal = 0;
	321	$no_fatal = 1;
327afb7f	322	}
d3a7d8c7 GS	323	elsif ($catmask = $Bits{$word}) {
	324	$mask \|= $catmask ;
	325	$mask \|= $DeadBits{$word} if $fatal ;
6e9af7e4	326	$mask &= ~($DeadBits{$word}\|$All) if $no_fatal ;
599cee73	327	}
d3a7d8c7	328	else
c3186b65	329	{ Croaker("Unknown warnings category '$word'")}
599cee73 PM	330	}
	331
	332	return $mask ;
	333	}
	334
6e9af7e4 PM	335	sub import
6e9af7e4 PM	336	{
599cee73	337	shift;
6e9af7e4 PM	338
	339	my $catmask ;
	340	my $fatal = 0 ;
	341	my $no_fatal = 0 ;
	342
f1f33818	343	my $mask = ${^WARNING_BITS} ;
6e9af7e4	344
f1f33818 PM	345	if (vec($mask, $Offsets{'all'}, 1)) {
	346	$mask \|= $Bits{'all'} ;
	347	$mask \|= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
	348	}
6e9af7e4 PM	349
	350	push @_, 'all' unless @_;
	351
	352	foreach my $word ( @_ ) {
	353	if ($word eq 'FATAL') {
	354	$fatal = 1;
	355	$no_fatal = 0;
	356	}
	357	elsif ($word eq 'NONFATAL') {
	358	$fatal = 0;
	359	$no_fatal = 1;
	360	}
	361	elsif ($catmask = $Bits{$word}) {
	362	$mask \|= $catmask ;
	363	$mask \|= $DeadBits{$word} if $fatal ;
	364	$mask &= ~($DeadBits{$word}\|$All) if $no_fatal ;
	365	}
	366	else
	367	{ Croaker("Unknown warnings category '$word'")}
	368	}
	369
	370	${^WARNING_BITS} = $mask ;
599cee73 PM	371	}
599cee73 PM	372
6e9af7e4 PM	373	sub unimport
6e9af7e4 PM	374	{
599cee73	375	shift;
6e9af7e4 PM	376
6e9af7e4 PM	377	my $catmask ;
d3a7d8c7	378	my $mask = ${^WARNING_BITS} ;
6e9af7e4	379
d3a7d8c7	380	if (vec($mask, $Offsets{'all'}, 1)) {
f1f33818	381	$mask \|= $Bits{'all'} ;
d3a7d8c7 GS	382	$mask \|= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
d3a7d8c7 GS	383	}
6e9af7e4 PM	384
	385	push @_, 'all' unless @_;
	386
	387	foreach my $word ( @_ ) {
	388	if ($word eq 'FATAL') {
	389	next;
	390	}
	391	elsif ($catmask = $Bits{$word}) {
	392	$mask &= ~($catmask \| $DeadBits{$word} \| $All);
	393	}
	394	else
	395	{ Croaker("Unknown warnings category '$word'")}
	396	}
	397
	398	${^WARNING_BITS} = $mask ;
599cee73 PM	399	}
599cee73 PM	400
9df0f64f MK	401	my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
9df0f64f MK	402
7e6d00f8	403	sub __chk
599cee73	404	{
d3a7d8c7 GS	405	my $category ;
d3a7d8c7 GS	406	my $offset ;
7e6d00f8	407	my $isobj = 0 ;
d3a7d8c7 GS	408
	409	if (@_) {
	410	# check the category supplied.
	411	$category = shift ;
9df0f64f MK	412	if (my $type = ref $category) {
	413	Croaker("not an object")
	414	if exists $builtin_type{$type};
	415	$category = $type;
7e6d00f8 PM	416	$isobj = 1 ;
7e6d00f8 PM	417	}
d3a7d8c7	418	$offset = $Offsets{$category};
c3186b65	419	Croaker("Unknown warnings category '$category'")
d3a7d8c7 GS	420	unless defined $offset;
	421	}
	422	else {
0ca4541c	423	$category = (caller(1))[0] ;
d3a7d8c7	424	$offset = $Offsets{$category};
c3186b65	425	Croaker("package '$category' not registered for warnings")
d3a7d8c7 GS	426	unless defined $offset ;
	427	}
	428
0ca4541c	429	my $this_pkg = (caller(1))[0] ;
7e6d00f8 PM	430	my $i = 2 ;
	431	my $pkg ;
	432
	433	if ($isobj) {
	434	while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
	435	last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
	436	}
	437	$i -= 2 ;
	438	}
	439	else {
4f527b71	440	$i = _error_loc(); # see where Carp will allocate the error
7e6d00f8 PM	441	}
7e6d00f8 PM	442
0ca4541c	443	my $callers_bitmask = (caller($i))[9] ;
7e6d00f8 PM	444	return ($callers_bitmask, $offset, $i) ;
	445	}
	446
4f527b71 AS	447	sub _error_loc {
	448	require Carp::Heavy;
	449	goto &Carp::short_error_loc; # don't introduce another stack frame
	450	}
	451
7e6d00f8 PM	452	sub enabled
7e6d00f8 PM	453	{
c3186b65	454	Croaker("Usage: warnings::enabled([category])")
7e6d00f8 PM	455	unless @_ == 1 \|\| @_ == 0 ;
	456
	457	my ($callers_bitmask, $offset, $i) = __chk(@_) ;
	458
	459	return 0 unless defined $callers_bitmask ;
d3a7d8c7 GS	460	return vec($callers_bitmask, $offset, 1) \|\|
d3a7d8c7 GS	461	vec($callers_bitmask, $Offsets{'all'}, 1) ;
599cee73 PM	462	}
599cee73 PM	463
d3a7d8c7	464
e476b1b5 GS	465	sub warn
e476b1b5 GS	466	{
c3186b65	467	Croaker("Usage: warnings::warn([category,] 'message')")
d3a7d8c7	468	unless @_ == 2 \|\| @_ == 1 ;
d3a7d8c7	469
7e6d00f8 PM	470	my $message = pop ;
7e6d00f8 PM	471	my ($callers_bitmask, $offset, $i) = __chk(@_) ;
09e96b99	472	require Carp;
8becbb3b	473	Carp::croak($message)
d3a7d8c7 GS	474	if vec($callers_bitmask, $offset+1, 1) \|\|
d3a7d8c7 GS	475	vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
8becbb3b	476	Carp::carp($message) ;
e476b1b5 GS	477	}
e476b1b5 GS	478
7e6d00f8 PM	479	sub warnif
7e6d00f8 PM	480	{
c3186b65	481	Croaker("Usage: warnings::warnif([category,] 'message')")
7e6d00f8 PM	482	unless @_ == 2 \|\| @_ == 1 ;
	483
	484	my $message = pop ;
	485	my ($callers_bitmask, $offset, $i) = __chk(@_) ;
7e6d00f8	486
0ca4541c	487	return
7e6d00f8 PM	488	unless defined $callers_bitmask &&
	489	(vec($callers_bitmask, $offset, 1) \|\|
	490	vec($callers_bitmask, $Offsets{'all'}, 1)) ;
	491
09e96b99	492	require Carp;
8becbb3b	493	Carp::croak($message)
7e6d00f8 PM	494	if vec($callers_bitmask, $offset+1, 1) \|\|
	495	vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
	496
8becbb3b	497	Carp::carp($message) ;
7e6d00f8	498	}
0d658bf5	499
599cee73	500	1;
37442d52	501	# ex: set ro: