[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.06';

# Verify that we're called correctly so that warnings will work.
# see also strict.pm.
unless ( __FILE__ =~ /(^|[\/\\])\Q@{[__PACKAGE__]}\E\.pm$/ ) {
    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,
  );

our %Bits = (
    'all'		=> "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x05", # [0..45]
    '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]
    '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\x0a", # [0..45]
    '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]
    '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 = 92 ;
$BYTES    = 12 ;

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

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