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