[p5sagit/p5-mst-13.2.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.07';

# Verify that we're called correctly so that warnings will work.
# see also strict.pm.
unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) {
    my (undef, $f, $l) = caller;
    die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n");
}

=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.011

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