lib/warnings.pm

   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
   7 package warnings;
   8
   9 our $VERSION = '1.10';
  10
  11 # Verify that we're called correctly so that warnings will work.
  12 # see also strict.pm.
  13 unless ( __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
  20 warnings - 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
  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
  53 If no import list is supplied, all possible warnings are either enabled
  54 or disabled.
  55
  56 A number of functions are provided to assist module authors.
  57
  58 =over 4
  59
  60 =item use warnings::register
  61
  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::fatal_enabled()
  88
  89 Return TRUE if the warnings category with the same name as the current
  90 package has been set to FATAL in the calling module.
  91 Otherwise returns FALSE.
  92
  93 =item warnings::fatal_enabled($category)
  94
  95 Return TRUE if the warnings category C<$category> has been set to FATAL in
  96 the calling module.
  97 Otherwise returns FALSE.
  98
  99 =item warnings::fatal_enabled($object)
 100
 101 Use the name of the class for the object reference, C<$object>, as the
 102 warnings category.
 103
 104 Return TRUE if that warnings category has been set to FATAL in the first
 105 scope where the object is used.
 106 Otherwise returns FALSE.
 107
 108 =item warnings::warn($message)
 109
 110 Print C<$message> to STDERR.
 111
 112 Use the warnings category with the same name as the current package.
 113
 114 If that warnings category has been set to "FATAL" in the calling module
 115 then die. Otherwise return.
 116
 117 =item warnings::warn($category, $message)
 118
 119 Print C<$message> to STDERR.
 120
 121 If the warnings category, C<$category>, has been set to "FATAL" in the
 122 calling module then die. Otherwise return.
 123
 124 =item warnings::warn($object, $message)
 125
 126 Print C<$message> to STDERR.
 127
 128 Use the name of the class for the object reference, C<$object>, as the
 129 warnings category.
 130
 131 If that warnings category has been set to "FATAL" in the scope where C<$object>
 132 is first used then die. Otherwise return.
 133
 134
 135 =item warnings::warnif($message)
 136
 137 Equivalent to:
 138
 139     if (warnings::enabled())
 140       { warnings::warn($message) }
 141
 142 =item warnings::warnif($category, $message)
 143
 144 Equivalent to:
 145
 146     if (warnings::enabled($category))
 147       { warnings::warn($category, $message) }
 148
 149 =item warnings::warnif($object, $message)
 150
 151 Equivalent to:
 152
 153     if (warnings::enabled($object))
 154       { warnings::warn($object, $message) }
 155
 156 =back
 157
 158 See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
 159
 160 =cut
 161
 162 our %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
 219 our %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
 270 our %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
 327 sub Croaker
 328 {
 329     require Carp; # this initializes %CarpInternal
 330     local $Carp::CarpInternal{'warnings'};
 331     delete $Carp::CarpInternal{'warnings'};
 332     Carp::croak(@_);
 333 }
 334
 335 sub _bits {
 336     my $mask = shift ;
 337     my $catmask ;
 338     my $fatal = 0 ;
 339     my $no_fatal = 0 ;
 340
 341     foreach my $word ( @_ ) {
 342         if ($word eq 'FATAL') {
 343             $fatal = 1;
 344             $no_fatal = 0;
 345         }
 346         elsif ($word eq 'NONFATAL') {
 347             $fatal = 0;
 348             $no_fatal = 1;
 349         }
 350         elsif ($catmask = $Bits{$word}) {
 351             $mask |= $catmask ;
 352             $mask |= $DeadBits{$word} if $fatal ;
 353             $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
 354         }
 355         else
 356           { Croaker("Unknown warnings category '$word'")}
 357     }
 358
 359     return $mask ;
 360 }
 361
 362 sub bits
 363 {
 364     # called from B::Deparse.pm
 365     push @_, 'all' unless @_ ;
 366     return _bits(undef, @_) ;
 367 }
 368
 369 sub import
 370 {
 371     shift;
 372
 373     my $mask = ${^WARNING_BITS} ;
 374
 375     if (vec($mask, $Offsets{'all'}, 1)) {
 376         $mask |= $Bits{'all'} ;
 377         $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
 378     }
 379
 380     # Empty @_ is equivalent to @_ = 'all' ;
 381     ${^WARNING_BITS} = @_ ? _bits($mask, @_) : $mask | $Bits{all} ;
 382 }
 383
 384 sub unimport
 385 {
 386     shift;
 387
 388     my $catmask ;
 389     my $mask = ${^WARNING_BITS} ;
 390
 391     if (vec($mask, $Offsets{'all'}, 1)) {
 392         $mask |= $Bits{'all'} ;
 393         $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
 394     }
 395
 396     push @_, 'all' unless @_;
 397
 398     foreach my $word ( @_ ) {
 399         if ($word eq 'FATAL') {
 400             next;
 401         }
 402         elsif ($catmask = $Bits{$word}) {
 403             $mask &= ~($catmask | $DeadBits{$word} | $All);
 404         }
 405         else
 406           { Croaker("Unknown warnings category '$word'")}
 407     }
 408
 409     ${^WARNING_BITS} = $mask ;
 410 }
 411
 412 my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
 413
 414 sub MESSAGE () { 4 };
 415 sub FATAL () { 2 };
 416 sub NORMAL () { 1 };
 417
 418 sub __chk
 419 {
 420     my $category ;
 421     my $offset ;
 422     my $isobj = 0 ;
 423     my $wanted = shift;
 424     my $has_message = $wanted & MESSAGE;
 425
 426     unless (@_ == 1 || @_ == ($has_message ? 2 : 0)) {
 427         my $sub = (caller 1)[3];
 428         my $syntax = $has_message ? "[category,] 'message'" : '[category]';
 429         Croaker("Usage: $sub($syntax)");
 430     }
 431
 432     my $message = pop if $has_message;
 433
 434     if (@_) {
 435         # check the category supplied.
 436         $category = shift ;
 437         if (my $type = ref $category) {
 438             Croaker("not an object")
 439                 if exists $builtin_type{$type};
 440             $category = $type;
 441             $isobj = 1 ;
 442         }
 443         $offset = $Offsets{$category};
 444         Croaker("Unknown warnings category '$category'")
 445             unless defined $offset;
 446     }
 447     else {
 448         $category = (caller(1))[0] ;
 449         $offset = $Offsets{$category};
 450         Croaker("package '$category' not registered for warnings")
 451             unless defined $offset ;
 452     }
 453
 454     my $i;
 455
 456     if ($isobj) {
 457         my $pkg;
 458         $i = 2;
 459         while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
 460             last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
 461         }
 462         $i -= 2 ;
 463     }
 464     else {
 465         $i = _error_loc(); # see where Carp will allocate the error
 466     }
 467
 468     # Defaulting this to 0 reduces complexity in code paths below.
 469     my $callers_bitmask = (caller($i))[9] || 0 ;
 470
 471     my @results;
 472     foreach my $type (FATAL, NORMAL) {
 473         next unless $wanted & $type;
 474
 475         push @results, (vec($callers_bitmask, $offset + $type - 1, 1) ||
 476                         vec($callers_bitmask, $Offsets{'all'} + $type - 1, 1));
 477     }
 478
 479     # &enabled and &fatal_enabled
 480     return $results[0] unless $has_message;
 481
 482     # &warnif, and the category is neither enabled as warning nor as fatal
 483     return if $wanted == (NORMAL | FATAL | MESSAGE)
 484         && !($results[0] || $results[1]);
 485
 486     require Carp;
 487     Carp::croak($message) if $results[0];
 488     # will always get here for &warn. will only get here for &warnif if the
 489     # category is enabled
 490     Carp::carp($message);
 491 }
 492
 493 sub _error_loc {
 494     require Carp;
 495     goto &Carp::short_error_loc; # don't introduce another stack frame
 496 }
 497
 498 sub enabled
 499 {
 500     return __chk(NORMAL, @_);
 501 }
 502
 503 sub fatal_enabled
 504 {
 505     return __chk(FATAL, @_);
 506 }
 507
 508 sub warn
 509 {
 510     return __chk(FATAL | MESSAGE, @_);
 511 }
 512
 513 sub warnif
 514 {
 515     return __chk(NORMAL | FATAL | MESSAGE, @_);
 516 }
 517
 518 # These are not part of any public interface, so we can delete them to save
 519 # space.
 520 delete $warnings::{$_} foreach qw(NORMAL FATAL MESSAGE);
 521
 522 1;
 523 # ex: set ro: