warnings.pl

   1 #!/usr/bin/perl
   2
   3
   4 $VERSION = '1.00';
   5
   6 BEGIN {
   7   push @INC, './lib';
   8 }
   9 use strict ;
  10
  11 sub DEFAULT_ON  () { 1 }
  12 sub DEFAULT_OFF () { 2 }
  13
  14 my $tree = {
  15
  16 'all' => {
  17         'io'            => {    'pipe'          => DEFAULT_OFF,
  18                                 'unopened'      => DEFAULT_OFF,
  19                                 'closed'        => DEFAULT_OFF,
  20                                 'newline'       => DEFAULT_OFF,
  21                                 'exec'          => DEFAULT_OFF,
  22                            },
  23         'syntax'        => {    'ambiguous'     => DEFAULT_OFF,
  24                                 'semicolon'     => DEFAULT_OFF,
  25                                 'precedence'    => DEFAULT_OFF,
  26                                 'bareword'      => DEFAULT_OFF,
  27                                 'reserved'      => DEFAULT_OFF,
  28                                 'digit'         => DEFAULT_OFF,
  29                                 'parenthesis'   => DEFAULT_OFF,
  30                                 'printf'        => DEFAULT_OFF,
  31                                 'prototype'     => DEFAULT_OFF,
  32                                 'qw'            => DEFAULT_OFF,
  33                            },
  34         'severe'        => {    'inplace'       => DEFAULT_ON,
  35                                 'internal'      => DEFAULT_ON,
  36                                 'debugging'     => DEFAULT_ON,
  37                                 'malloc'        => DEFAULT_ON,
  38                            },
  39         'deprecated'    => DEFAULT_OFF,
  40         'void'          => DEFAULT_OFF,
  41         'recursion'     => DEFAULT_OFF,
  42         'redefine'      => DEFAULT_OFF,
  43         'numeric'       => DEFAULT_OFF,
  44         'uninitialized' => DEFAULT_OFF,
  45         'once'          => DEFAULT_OFF,
  46         'misc'          => DEFAULT_OFF,
  47         'regexp'        => DEFAULT_OFF,
  48         'glob'          => DEFAULT_OFF,
  49         'y2k'           => DEFAULT_OFF,
  50         'untie'         => DEFAULT_OFF,
  51         'substr'        => DEFAULT_OFF,
  52         'taint'         => DEFAULT_OFF,
  53         'signal'        => DEFAULT_OFF,
  54         'closure'       => DEFAULT_OFF,
  55         'overflow'      => DEFAULT_OFF,
  56         'portable'      => DEFAULT_OFF,
  57         'utf8'          => DEFAULT_OFF,
  58         'exiting'       => DEFAULT_OFF,
  59         'pack'          => DEFAULT_OFF,
  60         'unpack'        => DEFAULT_OFF,
  61          #'default'     => DEFAULT_ON,
  62         }
  63 } ;
  64
  65
  66 ###########################################################################
  67 sub tab {
  68     my($l, $t) = @_;
  69     $t .= "\t" x ($l - (length($t) + 1) / 8);
  70     $t;
  71 }
  72
  73 ###########################################################################
  74
  75 my %list ;
  76 my %Value ;
  77 my $index ;
  78
  79 sub walk
  80 {
  81     my $tre = shift ;
  82     my @list = () ;
  83     my ($k, $v) ;
  84
  85     foreach $k (sort keys %$tre) {
  86         $v = $tre->{$k};
  87         die "duplicate key $k\n" if defined $list{$k} ;
  88         $Value{$index} = uc $k ;
  89         push @{ $list{$k} }, $index ++ ;
  90         if (ref $v)
  91           { push (@{ $list{$k} }, walk ($v)) }
  92         push @list, @{ $list{$k} } ;
  93     }
  94
  95    return @list ;
  96 }
  97
  98 ###########################################################################
  99
 100 sub mkRange
 101 {
 102     my @a = @_ ;
 103     my @out = @a ;
 104     my $i ;
 105
 106
 107     for ($i = 1 ; $i < @a; ++ $i) {
 108         $out[$i] = ".."
 109           if $a[$i] == $a[$i - 1] + 1 && $a[$i] + 1 == $a[$i + 1] ;
 110     }
 111
 112     my $out = join(",",@out);
 113
 114     $out =~ s/,(\.\.,)+/../g ;
 115     return $out;
 116 }
 117
 118 ###########################################################################
 119 sub printTree
 120 {
 121     my $tre = shift ;
 122     my $prefix = shift ;
 123     my $indent = shift ;
 124     my ($k, $v) ;
 125
 126     my $max = (sort {$a <=> $b} map { length $_ } keys %$tre)[-1] ;
 127
 128     $prefix .= " " x $indent ;
 129     foreach $k (sort keys %$tre) {
 130         $v = $tre->{$k};
 131         print $prefix . "|\n" ;
 132         print $prefix . "+- $k" ;
 133         if (ref $v)
 134         {
 135             print " " . "-" x ($max - length $k ) . "+\n" ;
 136             printTree ($v, $prefix . "|" , $max + $indent - 1)
 137         }
 138         else
 139           { print "\n" }
 140     }
 141
 142 }
 143
 144 ###########################################################################
 145
 146 sub mkHexOct
 147 {
 148     my ($f, $max, @a) = @_ ;
 149     my $mask = "\x00" x $max ;
 150     my $string = "" ;
 151
 152     foreach (@a) {
 153         vec($mask, $_, 1) = 1 ;
 154     }
 155
 156     foreach (unpack("C*", $mask)) {
 157         if ($f eq 'x') {
 158             $string .= '\x' . sprintf("%2.2x", $_)
 159         }
 160         else {
 161             $string .= '\\' . sprintf("%o", $_)
 162         }
 163     }
 164     return $string ;
 165 }
 166
 167 sub mkHex
 168 {
 169     my($max, @a) = @_;
 170     return mkHexOct("x", $max, @a);
 171 }
 172
 173 sub mkOct
 174 {
 175     my($max, @a) = @_;
 176     return mkHexOct("o", $max, @a);
 177 }
 178
 179 ###########################################################################
 180
 181 if (@ARGV && $ARGV[0] eq "tree")
 182 {
 183     #print "  all -+\n" ;
 184     printTree($tree, "   ", 4) ;
 185     exit ;
 186 }
 187
 188 unlink "warnings.h";
 189 unlink "lib/warnings.pm";
 190 open(WARN, ">warnings.h") || die "Can't create warnings.h: $!\n";
 191 open(PM, ">lib/warnings.pm") || die "Can't create lib/warnings.pm: $!\n";
 192
 193 print WARN <<'EOM' ;
 194 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
 195    This file is built by warnings.pl
 196    Any changes made here will be lost!
 197 */
 198
 199
 200 #define Off(x)                  ((x) / 8)
 201 #define Bit(x)                  (1 << ((x) % 8))
 202 #define IsSet(a, x)             ((a)[Off(x)] & Bit(x))
 203
 204
 205 #define G_WARN_OFF              0       /* $^W == 0 */
 206 #define G_WARN_ON               1       /* -w flag and $^W != 0 */
 207 #define G_WARN_ALL_ON           2       /* -W flag */
 208 #define G_WARN_ALL_OFF          4       /* -X flag */
 209 #define G_WARN_ONCE             8       /* set if 'once' ever enabled */
 210 #define G_WARN_ALL_MASK         (G_WARN_ALL_ON|G_WARN_ALL_OFF)
 211
 212 #define pWARN_STD               Nullsv
 213 #define pWARN_ALL               (Nullsv+1)      /* use warnings 'all' */
 214 #define pWARN_NONE              (Nullsv+2)      /* no  warnings 'all' */
 215
 216 #define specialWARN(x)          ((x) == pWARN_STD || (x) == pWARN_ALL ||        \
 217                                  (x) == pWARN_NONE)
 218 EOM
 219
 220 my $offset = 0 ;
 221
 222 $index = $offset ;
 223 #@{ $list{"all"} } = walk ($tree) ;
 224 walk ($tree) ;
 225
 226 die <<EOM if $index > 255 ;
 227 Too many warnings categories -- max is 255
 228     rewrite packWARN* & unpackWARN* macros
 229 EOM
 230
 231 $index *= 2 ;
 232 my $warn_size = int($index / 8) + ($index % 8 != 0) ;
 233
 234 my $k ;
 235 foreach $k (sort { $a <=> $b } keys %Value) {
 236     print WARN tab(5, "#define WARN_$Value{$k}"), "$k\n" ;
 237 }
 238 print WARN "\n" ;
 239
 240 print WARN tab(5, '#define WARNsize'),  "$warn_size\n" ;
 241 #print WARN tab(5, '#define WARN_ALLstring'), '"', ('\377' x $warn_size) , "\"\n" ;
 242 print WARN tab(5, '#define WARN_ALLstring'), '"', ('\125' x $warn_size) , "\"\n" ;
 243 print WARN tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) , "\"\n" ;
 244 my $WARN_TAINTstring = mkOct($warn_size, map $_ * 2, @{ $list{'taint'} });
 245
 246 print WARN tab(5, '#define WARN_TAINTstring'), qq["$WARN_TAINTstring"\n] ;
 247
 248 print WARN <<'EOM';
 249
 250 #define isLEXWARN_on    (PL_curcop->cop_warnings != pWARN_STD)
 251 #define isLEXWARN_off   (PL_curcop->cop_warnings == pWARN_STD)
 252 #define isWARN_ONCE     (PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
 253 #define isWARN_on(c,x)  (IsSet(SvPVX(c), 2*(x)))
 254 #define isWARNf_on(c,x) (IsSet(SvPVX(c), 2*(x)+1))
 255
 256 #define ckWARN(x)                                                       \
 257         ( (isLEXWARN_on && PL_curcop->cop_warnings != pWARN_NONE &&     \
 258               (PL_curcop->cop_warnings == pWARN_ALL ||                  \
 259                isWARN_on(PL_curcop->cop_warnings, x) ) )                \
 260           || (isLEXWARN_off && PL_dowarn & G_WARN_ON) )
 261
 262 #define ckWARN2(x,y)                                                    \
 263           ( (isLEXWARN_on && PL_curcop->cop_warnings != pWARN_NONE &&   \
 264               (PL_curcop->cop_warnings == pWARN_ALL ||                  \
 265                 isWARN_on(PL_curcop->cop_warnings, x)  ||               \
 266                 isWARN_on(PL_curcop->cop_warnings, y) ) )               \
 267             ||  (isLEXWARN_off && PL_dowarn & G_WARN_ON) )
 268
 269 #define ckWARN3(x,y,z)                                                  \
 270           ( (isLEXWARN_on && PL_curcop->cop_warnings != pWARN_NONE &&   \
 271               (PL_curcop->cop_warnings == pWARN_ALL ||                  \
 272                 isWARN_on(PL_curcop->cop_warnings, x)  ||               \
 273                 isWARN_on(PL_curcop->cop_warnings, y)  ||               \
 274                 isWARN_on(PL_curcop->cop_warnings, z) ) )               \
 275             ||  (isLEXWARN_off && PL_dowarn & G_WARN_ON) )
 276
 277 #define ckWARN4(x,y,z,t)                                                \
 278           ( (isLEXWARN_on && PL_curcop->cop_warnings != pWARN_NONE &&   \
 279               (PL_curcop->cop_warnings == pWARN_ALL ||                  \
 280                 isWARN_on(PL_curcop->cop_warnings, x)  ||               \
 281                 isWARN_on(PL_curcop->cop_warnings, y)  ||               \
 282                 isWARN_on(PL_curcop->cop_warnings, z)  ||               \
 283                 isWARN_on(PL_curcop->cop_warnings, t) ) )               \
 284             ||  (isLEXWARN_off && PL_dowarn & G_WARN_ON) )
 285
 286 #define ckWARN_d(x)                                                     \
 287           (isLEXWARN_off || PL_curcop->cop_warnings == pWARN_ALL ||     \
 288              (PL_curcop->cop_warnings != pWARN_NONE &&                  \
 289               isWARN_on(PL_curcop->cop_warnings, x) ) )
 290
 291 #define ckWARN2_d(x,y)                                                  \
 292           (isLEXWARN_off || PL_curcop->cop_warnings == pWARN_ALL ||     \
 293              (PL_curcop->cop_warnings != pWARN_NONE &&                  \
 294                 (isWARN_on(PL_curcop->cop_warnings, x)  ||              \
 295                  isWARN_on(PL_curcop->cop_warnings, y) ) ) )
 296
 297 #define ckWARN3_d(x,y,z)                                                \
 298           (isLEXWARN_off || PL_curcop->cop_warnings == pWARN_ALL ||     \
 299              (PL_curcop->cop_warnings != pWARN_NONE &&                  \
 300                 (isWARN_on(PL_curcop->cop_warnings, x)  ||              \
 301                  isWARN_on(PL_curcop->cop_warnings, y)  ||              \
 302                  isWARN_on(PL_curcop->cop_warnings, z) ) ) )
 303
 304 #define ckWARN4_d(x,y,z,t)                                              \
 305           (isLEXWARN_off || PL_curcop->cop_warnings == pWARN_ALL ||     \
 306              (PL_curcop->cop_warnings != pWARN_NONE &&                  \
 307                 (isWARN_on(PL_curcop->cop_warnings, x)  ||              \
 308                  isWARN_on(PL_curcop->cop_warnings, y)  ||              \
 309                  isWARN_on(PL_curcop->cop_warnings, z)  ||              \
 310                  isWARN_on(PL_curcop->cop_warnings, t) ) ) )
 311
 312 #define packWARN(a)             (a                                 )
 313 #define packWARN2(a,b)          ((a) | (b)<<8                      )
 314 #define packWARN3(a,b,c)        ((a) | (b)<<8 | (c) <<16           )
 315 #define packWARN4(a,b,c,d)      ((a) | (b)<<8 | (c) <<16 | (d) <<24)
 316
 317 #define unpackWARN1(x)          ((x)        & 0xFF)
 318 #define unpackWARN2(x)          (((x) >>8)  & 0xFF)
 319 #define unpackWARN3(x)          (((x) >>16) & 0xFF)
 320 #define unpackWARN4(x)          (((x) >>24) & 0xFF)
 321
 322 #define ckDEAD(x)                                                       \
 323            ( ! specialWARN(PL_curcop->cop_warnings) &&                  \
 324             ( isWARNf_on(PL_curcop->cop_warnings, WARN_ALL) ||          \
 325               isWARNf_on(PL_curcop->cop_warnings, unpackWARN1(x)) ||    \
 326               isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) ||    \
 327               isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) ||    \
 328               isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x))))
 329
 330 /* end of file warnings.h */
 331
 332 EOM
 333
 334 close WARN ;
 335
 336 while (<DATA>) {
 337     last if /^KEYWORDS$/ ;
 338     print PM $_ ;
 339 }
 340
 341 #$list{'all'} = [ $offset .. 8 * ($warn_size/2) - 1 ] ;
 342
 343 #my %Keys = map {lc $Value{$_}, $_} keys %Value ;
 344
 345 print PM "%Offsets = (\n" ;
 346 foreach my $k (sort { $a <=> $b } keys %Value) {
 347     my $v = lc $Value{$k} ;
 348     $k *= 2 ;
 349     print PM tab(4, "    '$v'"), "=> $k,\n" ;
 350 }
 351
 352 print PM "  );\n\n" ;
 353
 354 print PM "%Bits = (\n" ;
 355 foreach $k (sort keys  %list) {
 356
 357     my $v = $list{$k} ;
 358     my @list = sort { $a <=> $b } @$v ;
 359
 360     print PM tab(4, "    '$k'"), '=> "',
 361                 # mkHex($warn_size, @list),
 362                 mkHex($warn_size, map $_ * 2 , @list),
 363                 '", # [', mkRange(@list), "]\n" ;
 364 }
 365
 366 print PM "  );\n\n" ;
 367
 368 print PM "%DeadBits = (\n" ;
 369 foreach $k (sort keys  %list) {
 370
 371     my $v = $list{$k} ;
 372     my @list = sort { $a <=> $b } @$v ;
 373
 374     print PM tab(4, "    '$k'"), '=> "',
 375                 # mkHex($warn_size, @list),
 376                 mkHex($warn_size, map $_ * 2 + 1 , @list),
 377                 '", # [', mkRange(@list), "]\n" ;
 378 }
 379
 380 print PM "  );\n\n" ;
 381 print PM '$NONE     = "', ('\0' x $warn_size) , "\";\n" ;
 382 print PM '$LAST_BIT = ' . "$index ;\n" ;
 383 print PM '$BYTES    = ' . "$warn_size ;\n" ;
 384 while (<DATA>) {
 385     print PM $_ ;
 386 }
 387
 388 close PM ;
 389
 390 __END__
 391
 392 # This file was created by warnings.pl
 393 # Any changes made here will be lost.
 394 #
 395
 396 package warnings;
 397
 398 our $VERSION = '1.00';
 399
 400 =head1 NAME
 401
 402 warnings - Perl pragma to control optional warnings
 403
 404 =head1 SYNOPSIS
 405
 406     use warnings;
 407     no warnings;
 408
 409     use warnings "all";
 410     no warnings "all";
 411
 412     use warnings::register;
 413     if (warnings::enabled()) {
 414         warnings::warn("some warning");
 415     }
 416
 417     if (warnings::enabled("void")) {
 418         warnings::warn("void", "some warning");
 419     }
 420
 421     if (warnings::enabled($object)) {
 422         warnings::warn($object, "some warning");
 423     }
 424
 425     warnings::warnif("some warning");
 426     warnings::warnif("void", "some warning");
 427     warnings::warnif($object, "some warning");
 428
 429 =head1 DESCRIPTION
 430
 431 If no import list is supplied, all possible warnings are either enabled
 432 or disabled.
 433
 434 A number of functions are provided to assist module authors.
 435
 436 =over 4
 437
 438 =item use warnings::register
 439
 440 Creates a new warnings category with the same name as the package where
 441 the call to the pragma is used.
 442
 443 =item warnings::enabled()
 444
 445 Use the warnings category with the same name as the current package.
 446
 447 Return TRUE if that warnings category is enabled in the calling module.
 448 Otherwise returns FALSE.
 449
 450 =item warnings::enabled($category)
 451
 452 Return TRUE if the warnings category, C<$category>, is enabled in the
 453 calling module.
 454 Otherwise returns FALSE.
 455
 456 =item warnings::enabled($object)
 457
 458 Use the name of the class for the object reference, C<$object>, as the
 459 warnings category.
 460
 461 Return TRUE if that warnings category is enabled in the first scope
 462 where the object is used.
 463 Otherwise returns FALSE.
 464
 465 =item warnings::warn($message)
 466
 467 Print C<$message> to STDERR.
 468
 469 Use the warnings category with the same name as the current package.
 470
 471 If that warnings category has been set to "FATAL" in the calling module
 472 then die. Otherwise return.
 473
 474 =item warnings::warn($category, $message)
 475
 476 Print C<$message> to STDERR.
 477
 478 If the warnings category, C<$category>, has been set to "FATAL" in the
 479 calling module then die. Otherwise return.
 480
 481 =item warnings::warn($object, $message)
 482
 483 Print C<$message> to STDERR.
 484
 485 Use the name of the class for the object reference, C<$object>, as the
 486 warnings category.
 487
 488 If that warnings category has been set to "FATAL" in the scope where C<$object>
 489 is first used then die. Otherwise return.
 490
 491
 492 =item warnings::warnif($message)
 493
 494 Equivalent to:
 495
 496     if (warnings::enabled())
 497       { warnings::warn($message) }
 498
 499 =item warnings::warnif($category, $message)
 500
 501 Equivalent to:
 502
 503     if (warnings::enabled($category))
 504       { warnings::warn($category, $message) }
 505
 506 =item warnings::warnif($object, $message)
 507
 508 Equivalent to:
 509
 510     if (warnings::enabled($object))
 511       { warnings::warn($object, $message) }
 512
 513 =back
 514
 515 See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
 516
 517 =cut
 518
 519 use Carp ;
 520
 521 KEYWORDS
 522
 523 $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
 524
 525 sub bits {
 526     my $mask ;
 527     my $catmask ;
 528     my $fatal = 0 ;
 529     foreach my $word (@_) {
 530         if  ($word eq 'FATAL') {
 531             $fatal = 1;
 532         }
 533         elsif ($catmask = $Bits{$word}) {
 534             $mask |= $catmask ;
 535             $mask |= $DeadBits{$word} if $fatal ;
 536         }
 537         else
 538           { croak("Unknown warnings category '$word'")}
 539     }
 540
 541     return $mask ;
 542 }
 543
 544 sub import {
 545     shift;
 546     my $mask = ${^WARNING_BITS} ;
 547     if (vec($mask, $Offsets{'all'}, 1)) {
 548         $mask |= $Bits{'all'} ;
 549         $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
 550     }
 551     ${^WARNING_BITS} = $mask | bits(@_ ? @_ : 'all') ;
 552 }
 553
 554 sub unimport {
 555     shift;
 556     my $mask = ${^WARNING_BITS} ;
 557     if (vec($mask, $Offsets{'all'}, 1)) {
 558         $mask |= $Bits{'all'} ;
 559         $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
 560     }
 561     ${^WARNING_BITS} = $mask & ~ (bits('FATAL' => (@_ ? @_ : 'all')) | $All) ;
 562 }
 563
 564 sub __chk
 565 {
 566     my $category ;
 567     my $offset ;
 568     my $isobj = 0 ;
 569
 570     if (@_) {
 571         # check the category supplied.
 572         $category = shift ;
 573         if (ref $category) {
 574             croak ("not an object")
 575                 if $category !~ /^([^=]+)=/ ;
 576             $category = $1 ;
 577             $isobj = 1 ;
 578         }
 579         $offset = $Offsets{$category};
 580         croak("Unknown warnings category '$category'")
 581             unless defined $offset;
 582     }
 583     else {
 584         $category = (caller(1))[0] ;
 585         $offset = $Offsets{$category};
 586         croak("package '$category' not registered for warnings")
 587             unless defined $offset ;
 588     }
 589
 590     my $this_pkg = (caller(1))[0] ;
 591     my $i = 2 ;
 592     my $pkg ;
 593
 594     if ($isobj) {
 595         while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
 596             last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
 597         }
 598         $i -= 2 ;
 599     }
 600     else {
 601         for ($i = 2 ; $pkg = (caller($i))[0] ; ++ $i) {
 602             last if $pkg ne $this_pkg ;
 603         }
 604         $i = 2
 605             if !$pkg || $pkg eq $this_pkg ;
 606     }
 607
 608     my $callers_bitmask = (caller($i))[9] ;
 609     return ($callers_bitmask, $offset, $i) ;
 610 }
 611
 612 sub enabled
 613 {
 614     croak("Usage: warnings::enabled([category])")
 615         unless @_ == 1 || @_ == 0 ;
 616
 617     my ($callers_bitmask, $offset, $i) = __chk(@_) ;
 618
 619     return 0 unless defined $callers_bitmask ;
 620     return vec($callers_bitmask, $offset, 1) ||
 621            vec($callers_bitmask, $Offsets{'all'}, 1) ;
 622 }
 623
 624
 625 sub warn
 626 {
 627     croak("Usage: warnings::warn([category,] 'message')")
 628         unless @_ == 2 || @_ == 1 ;
 629
 630     my $message = pop ;
 631     my ($callers_bitmask, $offset, $i) = __chk(@_) ;
 632     local $Carp::CarpLevel = $i ;
 633     croak($message)
 634         if vec($callers_bitmask, $offset+1, 1) ||
 635            vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
 636     carp($message) ;
 637 }
 638
 639 sub warnif
 640 {
 641     croak("Usage: warnings::warnif([category,] 'message')")
 642         unless @_ == 2 || @_ == 1 ;
 643
 644     my $message = pop ;
 645     my ($callers_bitmask, $offset, $i) = __chk(@_) ;
 646     local $Carp::CarpLevel = $i ;
 647
 648     return
 649         unless defined $callers_bitmask &&
 650                 (vec($callers_bitmask, $offset, 1) ||
 651                 vec($callers_bitmask, $Offsets{'all'}, 1)) ;
 652
 653     croak($message)
 654         if vec($callers_bitmask, $offset+1, 1) ||
 655            vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
 656
 657     carp($message) ;
 658 }
 659 1;