This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
37e6e56556baf211d107867c7b74e3260ca7b192
[perl5.git] / lib / warnings.pm
1 # -*- buffer-read-only: t -*-
2 # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
3 # This file is built by regen/warnings.pl.
4 # Any changes made here will be lost!
5
6 package warnings;
7
8 our $VERSION = '1.24';
9
10 # Verify that we're called correctly so that warnings will work.
11 # see also strict.pm.
12 unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) {
13     my (undef, $f, $l) = caller;
14     die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n");
15 }
16
17 =head1 NAME
18
19 warnings - Perl pragma to control optional warnings
20
21 =head1 SYNOPSIS
22
23     use warnings;
24     no warnings;
25
26     use warnings "all";
27     no warnings "all";
28
29     use warnings::register;
30     if (warnings::enabled()) {
31         warnings::warn("some warning");
32     }
33
34     if (warnings::enabled("void")) {
35         warnings::warn("void", "some warning");
36     }
37
38     if (warnings::enabled($object)) {
39         warnings::warn($object, "some warning");
40     }
41
42     warnings::warnif("some warning");
43     warnings::warnif("void", "some warning");
44     warnings::warnif($object, "some warning");
45
46 =head1 DESCRIPTION
47
48 The C<warnings> pragma gives control over which warnings are enabled in
49 which parts of a Perl program.  It's a more flexible alternative for
50 both the command line flag B<-w> and the equivalent Perl variable,
51 C<$^W>.
52
53 This pragma works just like the C<strict> pragma.
54 This means that the scope of the warning pragma is limited to the
55 enclosing block.  It also means that the pragma setting will not
56 leak across files (via C<use>, C<require> or C<do>).  This allows
57 authors to independently define the degree of warning checks that will
58 be applied to their module.
59
60 By default, optional warnings are disabled, so any legacy code that
61 doesn't attempt to control the warnings will work unchanged.
62
63 All warnings are enabled in a block by either of these:
64
65     use warnings;
66     use warnings 'all';
67
68 Similarly all warnings are disabled in a block by either of these:
69
70     no warnings;
71     no warnings 'all';
72
73 For example, consider the code below:
74
75     use warnings;
76     my @a;
77     {
78         no warnings;
79         my $b = @a[0];
80     }
81     my $c = @a[0];
82
83 The code in the enclosing block has warnings enabled, but the inner
84 block has them disabled.  In this case that means the assignment to the
85 scalar C<$c> will trip the C<"Scalar value @a[0] better written as $a[0]">
86 warning, but the assignment to the scalar C<$b> will not.
87
88 =head2 Default Warnings and Optional Warnings
89
90 Before the introduction of lexical warnings, Perl had two classes of
91 warnings: mandatory and optional. 
92
93 As its name suggests, if your code tripped a mandatory warning, you
94 would get a warning whether you wanted it or not.
95 For example, the code below would always produce an C<"isn't numeric">
96 warning about the "2:".
97
98     my $a = "2:" + 3;
99
100 With the introduction of lexical warnings, mandatory warnings now become
101 I<default> warnings.  The difference is that although the previously
102 mandatory warnings are still enabled by default, they can then be
103 subsequently enabled or disabled with the lexical warning pragma.  For
104 example, in the code below, an C<"isn't numeric"> warning will only
105 be reported for the C<$a> variable.
106
107     my $a = "2:" + 3;
108     no warnings;
109     my $b = "2:" + 3;
110
111 Note that neither the B<-w> flag or the C<$^W> can be used to
112 disable/enable default warnings.  They are still mandatory in this case.
113
114 =head2 What's wrong with B<-w> and C<$^W>
115
116 Although very useful, the big problem with using B<-w> on the command
117 line to enable warnings is that it is all or nothing.  Take the typical
118 scenario when you are writing a Perl program.  Parts of the code you
119 will write yourself, but it's very likely that you will make use of
120 pre-written Perl modules.  If you use the B<-w> flag in this case, you
121 end up enabling warnings in pieces of code that you haven't written.
122
123 Similarly, using C<$^W> to either disable or enable blocks of code is
124 fundamentally flawed.  For a start, say you want to disable warnings in
125 a block of code.  You might expect this to be enough to do the trick:
126
127      {
128          local ($^W) = 0;
129          my $a =+ 2;
130          my $b; chop $b;
131      }
132
133 When this code is run with the B<-w> flag, a warning will be produced
134 for the C<$a> line:  C<"Reversed += operator">.
135
136 The problem is that Perl has both compile-time and run-time warnings.  To
137 disable compile-time warnings you need to rewrite the code like this:
138
139      {
140          BEGIN { $^W = 0 }
141          my $a =+ 2;
142          my $b; chop $b;
143      }
144
145 The other big problem with C<$^W> is the way you can inadvertently
146 change the warning setting in unexpected places in your code.  For example,
147 when the code below is run (without the B<-w> flag), the second call
148 to C<doit> will trip a C<"Use of uninitialized value"> warning, whereas
149 the first will not.
150
151     sub doit
152     {
153         my $b; chop $b;
154     }
155
156     doit();
157
158     {
159         local ($^W) = 1;
160         doit()
161     }
162
163 This is a side-effect of C<$^W> being dynamically scoped.
164
165 Lexical warnings get around these limitations by allowing finer control
166 over where warnings can or can't be tripped.
167
168 =head2 Controlling Warnings from the Command Line
169
170 There are three Command Line flags that can be used to control when
171 warnings are (or aren't) produced:
172
173 =over 5
174
175 =item B<-w>
176 X<-w>
177
178 This is  the existing flag.  If the lexical warnings pragma is B<not>
179 used in any of you code, or any of the modules that you use, this flag
180 will enable warnings everywhere.  See L<Backward Compatibility> for
181 details of how this flag interacts with lexical warnings.
182
183 =item B<-W>
184 X<-W>
185
186 If the B<-W> flag is used on the command line, it will enable all warnings
187 throughout the program regardless of whether warnings were disabled
188 locally using C<no warnings> or C<$^W =0>.
189 This includes all files that get
190 included via C<use>, C<require> or C<do>.
191 Think of it as the Perl equivalent of the "lint" command.
192
193 =item B<-X>
194 X<-X>
195
196 Does the exact opposite to the B<-W> flag, i.e. it disables all warnings.
197
198 =back
199
200 =head2 Backward Compatibility
201
202 If you are used to working with a version of Perl prior to the
203 introduction of lexically scoped warnings, or have code that uses both
204 lexical warnings and C<$^W>, this section will describe how they interact.
205
206 How Lexical Warnings interact with B<-w>/C<$^W>:
207
208 =over 5
209
210 =item 1.
211
212 If none of the three command line flags (B<-w>, B<-W> or B<-X>) that
213 control warnings is used and neither C<$^W> nor the C<warnings> pragma
214 are used, then default warnings will be enabled and optional warnings
215 disabled.
216 This means that legacy code that doesn't attempt to control the warnings
217 will work unchanged.
218
219 =item 2.
220
221 The B<-w> flag just sets the global C<$^W> variable as in 5.005.  This
222 means that any legacy code that currently relies on manipulating C<$^W>
223 to control warning behavior will still work as is. 
224
225 =item 3.
226
227 Apart from now being a boolean, the C<$^W> variable operates in exactly
228 the same horrible uncontrolled global way, except that it cannot
229 disable/enable default warnings.
230
231 =item 4.
232
233 If a piece of code is under the control of the C<warnings> pragma,
234 both the C<$^W> variable and the B<-w> flag will be ignored for the
235 scope of the lexical warning.
236
237 =item 5.
238
239 The only way to override a lexical warnings setting is with the B<-W>
240 or B<-X> command line flags.
241
242 =back
243
244 The combined effect of 3 & 4 is that it will allow code which uses
245 the C<warnings> pragma to control the warning behavior of $^W-type
246 code (using a C<local $^W=0>) if it really wants to, but not vice-versa.
247
248 =head2 Category Hierarchy
249 X<warning, categories>
250
251 A hierarchy of "categories" have been defined to allow groups of warnings
252 to be enabled/disabled in isolation.
253
254 The current hierarchy is:
255
256     all -+
257          |
258          +- closure
259          |
260          +- deprecated
261          |
262          +- exiting
263          |
264          +- experimental --+
265          |                 |
266          |                 +- experimental::autoderef
267          |                 |
268          |                 +- experimental::lexical_subs
269          |                 |
270          |                 +- experimental::lexical_topic
271          |                 |
272          |                 +- experimental::postderef
273          |                 |
274          |                 +- experimental::regex_sets
275          |                 |
276          |                 +- experimental::signatures
277          |                 |
278          |                 +- experimental::smartmatch
279          |                 |
280          |                 +- experimental::win32_perlio
281          |
282          +- glob
283          |
284          +- imprecision
285          |
286          +- io ------------+
287          |                 |
288          |                 +- closed
289          |                 |
290          |                 +- exec
291          |                 |
292          |                 +- layer
293          |                 |
294          |                 +- newline
295          |                 |
296          |                 +- pipe
297          |                 |
298          |                 +- syscalls
299          |                 |
300          |                 +- unopened
301          |
302          +- misc
303          |
304          +- numeric
305          |
306          +- once
307          |
308          +- overflow
309          |
310          +- pack
311          |
312          +- portable
313          |
314          +- recursion
315          |
316          +- redefine
317          |
318          +- regexp
319          |
320          +- severe --------+
321          |                 |
322          |                 +- debugging
323          |                 |
324          |                 +- inplace
325          |                 |
326          |                 +- internal
327          |                 |
328          |                 +- malloc
329          |
330          +- signal
331          |
332          +- substr
333          |
334          +- syntax --------+
335          |                 |
336          |                 +- ambiguous
337          |                 |
338          |                 +- bareword
339          |                 |
340          |                 +- digit
341          |                 |
342          |                 +- illegalproto
343          |                 |
344          |                 +- parenthesis
345          |                 |
346          |                 +- precedence
347          |                 |
348          |                 +- printf
349          |                 |
350          |                 +- prototype
351          |                 |
352          |                 +- qw
353          |                 |
354          |                 +- reserved
355          |                 |
356          |                 +- semicolon
357          |
358          +- taint
359          |
360          +- threads
361          |
362          +- uninitialized
363          |
364          +- unpack
365          |
366          +- untie
367          |
368          +- utf8 ----------+
369          |                 |
370          |                 +- non_unicode
371          |                 |
372          |                 +- nonchar
373          |                 |
374          |                 +- surrogate
375          |
376          +- void
377
378 Just like the "strict" pragma any of these categories can be combined
379
380     use warnings qw(void redefine);
381     no warnings qw(io syntax untie);
382
383 Also like the "strict" pragma, if there is more than one instance of the
384 C<warnings> pragma in a given scope the cumulative effect is additive. 
385
386     use warnings qw(void); # only "void" warnings enabled
387     ...
388     use warnings qw(io);   # only "void" & "io" warnings enabled
389     ...
390     no warnings qw(void);  # only "io" warnings enabled
391
392 To determine which category a specific warning has been assigned to see
393 L<perldiag>.
394
395 Note: Before Perl 5.8.0, the lexical warnings category "deprecated" was a
396 sub-category of the "syntax" category.  It is now a top-level category
397 in its own right.
398
399 =head2 Fatal Warnings
400 X<warning, fatal>
401
402 The presence of the word "FATAL" in the category list will escalate any
403 warnings detected from the categories specified in the lexical scope
404 into fatal errors.  In the code below, the use of C<time>, C<length>
405 and C<join> can all produce a C<"Useless use of xxx in void context">
406 warning.
407
408     use warnings;
409
410     time;
411
412     {
413         use warnings FATAL => qw(void);
414         length "abc";
415     }
416
417     join "", 1,2,3;
418
419     print "done\n";
420
421 When run it produces this output
422
423     Useless use of time in void context at fatal line 3.
424     Useless use of length in void context at fatal line 7.  
425
426 The scope where C<length> is used has escalated the C<void> warnings
427 category into a fatal error, so the program terminates immediately when it
428 encounters the warning.
429
430 To explicitly turn off a "FATAL" warning you just disable the warning
431 it is associated with.  So, for example, to disable the "void" warning
432 in the example above, either of these will do the trick:
433
434     no warnings qw(void);
435     no warnings FATAL => qw(void);
436
437 If you want to downgrade a warning that has been escalated into a fatal
438 error back to a normal warning, you can use the "NONFATAL" keyword.  For
439 example, the code below will promote all warnings into fatal errors,
440 except for those in the "syntax" category.
441
442     use warnings FATAL => 'all', NONFATAL => 'syntax';
443
444 As of Perl 5.20, instead of C<< use warnings FATAL => 'all'; >> you can
445 use:
446
447    use v5.20;       # Perl 5.20 or greater is required for the following
448    use warnings 'FATAL';  # short form of "use warnings FATAL => 'all';"
449
450 If you want your program to be compatible with versions of Perl before
451 5.20, you must use C<< use warnings FATAL => 'all'; >> instead.  (In
452 previous versions of Perl, the behavior of the statements
453 C<< use warnings 'FATAL'; >>, C<< use warnings 'NONFATAL'; >> and
454 C<< no warnings 'FATAL'; >> was unspecified; they did not behave as if
455 they included the C<< => 'all' >> portion.  As of 5.20, they do.)
456
457 B<NOTE:> Users of FATAL warnings, especially
458 those using C<< FATAL => 'all' >>
459 should be fully aware that they are risking future portability of their
460 programs by doing so.  Perl makes absolutely no commitments to not
461 introduce new warnings, or warnings categories in the future, and indeed
462 we explicitly reserve the right to do so.  Code that may not warn now may
463 warn in a future release of Perl if the Perl5 development team deems it
464 in the best interests of the community to do so.  Should code using FATAL
465 warnings break due to the introduction of a new warning we will NOT
466 consider it an incompatible change.  Users of FATAL warnings should take
467 special caution during upgrades to check to see if their code triggers
468 any new warnings and should pay particular attention to the fine print of
469 the documentation of the features they use to ensure they do not exploit
470 features that are documented as risky, deprecated, or unspecified, or where
471 the documentation says "so don't do that", or anything with the same sense
472 and spirit.  Use of such features in combination with FATAL warnings is
473 ENTIRELY AT THE USER'S RISK.
474
475 =head2 Reporting Warnings from a Module
476 X<warning, reporting> X<warning, registering>
477
478 The C<warnings> pragma provides a number of functions that are useful for
479 module authors.  These are used when you want to report a module-specific
480 warning to a calling module has enabled warnings via the C<warnings>
481 pragma.
482
483 Consider the module C<MyMod::Abc> below.
484
485     package MyMod::Abc;
486
487     use warnings::register;
488
489     sub open {
490         my $path = shift;
491         if ($path !~ m#^/#) {
492             warnings::warn("changing relative path to /var/abc")
493                 if warnings::enabled();
494             $path = "/var/abc/$path";
495         }
496     }
497
498     1;
499
500 The call to C<warnings::register> will create a new warnings category
501 called "MyMod::Abc", i.e. the new category name matches the current
502 package name.  The C<open> function in the module will display a warning
503 message if it gets given a relative path as a parameter.  This warnings
504 will only be displayed if the code that uses C<MyMod::Abc> has actually
505 enabled them with the C<warnings> pragma like below.
506
507     use MyMod::Abc;
508     use warnings 'MyMod::Abc';
509     ...
510     abc::open("../fred.txt");
511
512 It is also possible to test whether the pre-defined warnings categories are
513 set in the calling module with the C<warnings::enabled> function.  Consider
514 this snippet of code:
515
516     package MyMod::Abc;
517
518     sub open {
519         warnings::warnif("deprecated", 
520                          "open is deprecated, use new instead");
521         new(@_);
522     }
523
524     sub new
525     ...
526     1;
527
528 The function C<open> has been deprecated, so code has been included to
529 display a warning message whenever the calling module has (at least) the
530 "deprecated" warnings category enabled.  Something like this, say.
531
532     use warnings 'deprecated';
533     use MyMod::Abc;
534     ...
535     MyMod::Abc::open($filename);
536
537 Either the C<warnings::warn> or C<warnings::warnif> function should be
538 used to actually display the warnings message.  This is because they can
539 make use of the feature that allows warnings to be escalated into fatal
540 errors.  So in this case
541
542     use MyMod::Abc;
543     use warnings FATAL => 'MyMod::Abc';
544     ...
545     MyMod::Abc::open('../fred.txt');
546
547 the C<warnings::warnif> function will detect this and die after
548 displaying the warning message.
549
550 The three warnings functions, C<warnings::warn>, C<warnings::warnif>
551 and C<warnings::enabled> can optionally take an object reference in place
552 of a category name.  In this case the functions will use the class name
553 of the object as the warnings category.
554
555 Consider this example:
556
557     package Original;
558
559     no warnings;
560     use warnings::register;
561
562     sub new
563     {
564         my $class = shift;
565         bless [], $class;
566     }
567
568     sub check
569     {
570         my $self = shift;
571         my $value = shift;
572
573         if ($value % 2 && warnings::enabled($self))
574           { warnings::warn($self, "Odd numbers are unsafe") }
575     }
576
577     sub doit
578     {
579         my $self = shift;
580         my $value = shift;
581         $self->check($value);
582         # ...
583     }
584
585     1;
586
587     package Derived;
588
589     use warnings::register;
590     use Original;
591     our @ISA = qw( Original );
592     sub new
593     {
594         my $class = shift;
595         bless [], $class;
596     }
597
598
599     1;
600
601 The code below makes use of both modules, but it only enables warnings from 
602 C<Derived>.
603
604     use Original;
605     use Derived;
606     use warnings 'Derived';
607     my $a = Original->new();
608     $a->doit(1);
609     my $b = Derived->new();
610     $a->doit(1);
611
612 When this code is run only the C<Derived> object, C<$b>, will generate
613 a warning. 
614
615     Odd numbers are unsafe at main.pl line 7
616
617 Notice also that the warning is reported at the line where the object is first
618 used.
619
620 When registering new categories of warning, you can supply more names to
621 warnings::register like this:
622
623     package MyModule;
624     use warnings::register qw(format precision);
625
626     ...
627
628     warnings::warnif('MyModule::format', '...');
629
630 =head1 FUNCTIONS
631
632 =over 4
633
634 =item use warnings::register
635
636 Creates a new warnings category with the same name as the package where
637 the call to the pragma is used.
638
639 =item warnings::enabled()
640
641 Use the warnings category with the same name as the current package.
642
643 Return TRUE if that warnings category is enabled in the calling module.
644 Otherwise returns FALSE.
645
646 =item warnings::enabled($category)
647
648 Return TRUE if the warnings category, C<$category>, is enabled in the
649 calling module.
650 Otherwise returns FALSE.
651
652 =item warnings::enabled($object)
653
654 Use the name of the class for the object reference, C<$object>, as the
655 warnings category.
656
657 Return TRUE if that warnings category is enabled in the first scope
658 where the object is used.
659 Otherwise returns FALSE.
660
661 =item warnings::fatal_enabled()
662
663 Return TRUE if the warnings category with the same name as the current
664 package has been set to FATAL in the calling module.
665 Otherwise returns FALSE.
666
667 =item warnings::fatal_enabled($category)
668
669 Return TRUE if the warnings category C<$category> has been set to FATAL in
670 the calling module.
671 Otherwise returns FALSE.
672
673 =item warnings::fatal_enabled($object)
674
675 Use the name of the class for the object reference, C<$object>, as the
676 warnings category.
677
678 Return TRUE if that warnings category has been set to FATAL in the first
679 scope where the object is used.
680 Otherwise returns FALSE.
681
682 =item warnings::warn($message)
683
684 Print C<$message> to STDERR.
685
686 Use the warnings category with the same name as the current package.
687
688 If that warnings category has been set to "FATAL" in the calling module
689 then die. Otherwise return.
690
691 =item warnings::warn($category, $message)
692
693 Print C<$message> to STDERR.
694
695 If the warnings category, C<$category>, has been set to "FATAL" in the
696 calling module then die. Otherwise return.
697
698 =item warnings::warn($object, $message)
699
700 Print C<$message> to STDERR.
701
702 Use the name of the class for the object reference, C<$object>, as the
703 warnings category.
704
705 If that warnings category has been set to "FATAL" in the scope where C<$object>
706 is first used then die. Otherwise return.
707
708
709 =item warnings::warnif($message)
710
711 Equivalent to:
712
713     if (warnings::enabled())
714       { warnings::warn($message) }
715
716 =item warnings::warnif($category, $message)
717
718 Equivalent to:
719
720     if (warnings::enabled($category))
721       { warnings::warn($category, $message) }
722
723 =item warnings::warnif($object, $message)
724
725 Equivalent to:
726
727     if (warnings::enabled($object))
728       { warnings::warn($object, $message) }
729
730 =item warnings::register_categories(@names)
731
732 This registers warning categories for the given names and is primarily for
733 use by the warnings::register pragma.
734
735 =back
736
737 See also L<perlmodlib/Pragmatic Modules> and L<perldiag>.
738
739 =cut
740
741 our %Offsets = (
742
743     # Warnings Categories added in Perl 5.008
744
745     'all'               => 0,
746     'closure'           => 2,
747     'deprecated'        => 4,
748     'exiting'           => 6,
749     'glob'              => 8,
750     'io'                => 10,
751     'closed'            => 12,
752     'exec'              => 14,
753     'layer'             => 16,
754     'newline'           => 18,
755     'pipe'              => 20,
756     'unopened'          => 22,
757     'misc'              => 24,
758     'numeric'           => 26,
759     'once'              => 28,
760     'overflow'          => 30,
761     'pack'              => 32,
762     'portable'          => 34,
763     'recursion'         => 36,
764     'redefine'          => 38,
765     'regexp'            => 40,
766     'severe'            => 42,
767     'debugging'         => 44,
768     'inplace'           => 46,
769     'internal'          => 48,
770     'malloc'            => 50,
771     'signal'            => 52,
772     'substr'            => 54,
773     'syntax'            => 56,
774     'ambiguous'         => 58,
775     'bareword'          => 60,
776     'digit'             => 62,
777     'parenthesis'       => 64,
778     'precedence'        => 66,
779     'printf'            => 68,
780     'prototype'         => 70,
781     'qw'                => 72,
782     'reserved'          => 74,
783     'semicolon'         => 76,
784     'taint'             => 78,
785     'threads'           => 80,
786     'uninitialized'     => 82,
787     'unpack'            => 84,
788     'untie'             => 86,
789     'utf8'              => 88,
790     'void'              => 90,
791
792     # Warnings Categories added in Perl 5.011
793
794     'imprecision'       => 92,
795     'illegalproto'      => 94,
796
797     # Warnings Categories added in Perl 5.013
798
799     'non_unicode'       => 96,
800     'nonchar'           => 98,
801     'surrogate'         => 100,
802
803     # Warnings Categories added in Perl 5.017
804
805     'experimental'      => 102,
806     'experimental::lexical_subs'=> 104,
807     'experimental::lexical_topic'=> 106,
808     'experimental::regex_sets'=> 108,
809     'experimental::smartmatch'=> 110,
810
811     # Warnings Categories added in Perl 5.019
812
813     'experimental::autoderef'=> 112,
814     'experimental::postderef'=> 114,
815     'experimental::signatures'=> 116,
816     'syscalls'          => 118,
817
818     # Warnings Categories added in Perl 5.021
819
820     'experimental::win32_perlio'=> 120,
821   );
822
823 our %Bits = (
824     'all'               => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x01", # [0..60]
825     'ambiguous'         => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [29]
826     'bareword'          => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [30]
827     'closed'            => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
828     'closure'           => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
829     'debugging'         => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [22]
830     'deprecated'        => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
831     'digit'             => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [31]
832     'exec'              => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
833     'exiting'           => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
834     'experimental'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x55\x15\x01", # [51..58,60]
835     'experimental::autoderef'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [56]
836     'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [52]
837     'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [53]
838     'experimental::postderef'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [57]
839     'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [54]
840     'experimental::signatures'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [58]
841     'experimental::smartmatch'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [55]
842     'experimental::win32_perlio'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [60]
843     'glob'              => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
844     'illegalproto'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [47]
845     'imprecision'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [46]
846     'inplace'           => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [23]
847     'internal'          => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [24]
848     'io'                => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [5..11,59]
849     'layer'             => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
850     'malloc'            => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [25]
851     'misc'              => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
852     'newline'           => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
853     'non_unicode'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [48]
854     'nonchar'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [49]
855     'numeric'           => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
856     'once'              => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
857     'overflow'          => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
858     'pack'              => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
859     'parenthesis'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [32]
860     'pipe'              => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
861     'portable'          => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
862     'precedence'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [33]
863     'printf'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [34]
864     'prototype'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [35]
865     'qw'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [36]
866     'recursion'         => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
867     'redefine'          => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
868     'regexp'            => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
869     'reserved'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [37]
870     'semicolon'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [38]
871     'severe'            => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [21..25]
872     'signal'            => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [26]
873     'substr'            => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [27]
874     'surrogate'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [50]
875     'syntax'            => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x40\x00\x00\x00\x00", # [28..38,47]
876     'syscalls'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [59]
877     'taint'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [39]
878     'threads'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [40]
879     'uninitialized'     => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [41]
880     'unopened'          => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
881     'unpack'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [42]
882     'untie'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [43]
883     'utf8'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x15\x00\x00\x00", # [44,48..50]
884     'void'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [45]
885   );
886
887 our %DeadBits = (
888     'all'               => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x02", # [0..60]
889     'ambiguous'         => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [29]
890     'bareword'          => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [30]
891     'closed'            => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
892     'closure'           => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
893     'debugging'         => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [22]
894     'deprecated'        => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
895     'digit'             => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [31]
896     'exec'              => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
897     'exiting'           => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
898     'experimental'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xaa\x2a\x02", # [51..58,60]
899     'experimental::autoderef'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [56]
900     'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [52]
901     'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [53]
902     'experimental::postderef'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [57]
903     'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [54]
904     'experimental::signatures'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [58]
905     'experimental::smartmatch'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [55]
906     'experimental::win32_perlio'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [60]
907     'glob'              => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
908     'illegalproto'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [47]
909     'imprecision'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [46]
910     'inplace'           => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [23]
911     'internal'          => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [24]
912     'io'                => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [5..11,59]
913     'layer'             => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
914     'malloc'            => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [25]
915     'misc'              => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
916     'newline'           => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
917     'non_unicode'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [48]
918     'nonchar'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [49]
919     'numeric'           => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
920     'once'              => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
921     'overflow'          => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
922     'pack'              => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16]
923     'parenthesis'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [32]
924     'pipe'              => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
925     'portable'          => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17]
926     'precedence'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [33]
927     'printf'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [34]
928     'prototype'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [35]
929     'qw'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [36]
930     'recursion'         => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18]
931     'redefine'          => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19]
932     'regexp'            => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20]
933     'reserved'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [37]
934     'semicolon'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [38]
935     'severe'            => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [21..25]
936     'signal'            => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [26]
937     'substr'            => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [27]
938     'surrogate'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [50]
939     'syntax'            => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x80\x00\x00\x00\x00", # [28..38,47]
940     'syscalls'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [59]
941     'taint'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [39]
942     'threads'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [40]
943     'uninitialized'     => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [41]
944     'unopened'          => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
945     'unpack'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [42]
946     'untie'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [43]
947     'utf8'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x2a\x00\x00\x00", # [44,48..50]
948     'void'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [45]
949   );
950
951 $NONE     = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
952 $DEFAULT  = "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55\x15\x01", # [2,56,52,53,57,54,58,55,60,4,22,23,25]
953 $LAST_BIT = 122 ;
954 $BYTES    = 16 ;
955
956 $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
957
958 sub Croaker
959 {
960     require Carp; # this initializes %CarpInternal
961     local $Carp::CarpInternal{'warnings'};
962     delete $Carp::CarpInternal{'warnings'};
963     Carp::croak(@_);
964 }
965
966 sub _bits {
967     my $mask = shift ;
968     my $catmask ;
969     my $fatal = 0 ;
970     my $no_fatal = 0 ;
971
972     foreach my $word ( @_ ) {
973         if ($word eq 'FATAL') {
974             $fatal = 1;
975             $no_fatal = 0;
976         }
977         elsif ($word eq 'NONFATAL') {
978             $fatal = 0;
979             $no_fatal = 1;
980         }
981         elsif ($catmask = $Bits{$word}) {
982             $mask |= $catmask ;
983             $mask |= $DeadBits{$word} if $fatal ;
984             $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
985         }
986         else
987           { Croaker("Unknown warnings category '$word'")}
988     }
989
990     return $mask ;
991 }
992
993 sub bits
994 {
995     # called from B::Deparse.pm
996     push @_, 'all' unless @_ ;
997     return _bits(undef, @_) ;
998 }
999
1000 sub import
1001 {
1002     shift;
1003
1004     my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
1005
1006     if (vec($mask, $Offsets{'all'}, 1)) {
1007         $mask |= $Bits{'all'} ;
1008         $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
1009     }
1010
1011     # append 'all' when implied (after a lone "FATAL" or "NONFATAL")
1012     push @_, 'all' if @_==1 && ( $_[0] eq 'FATAL' || $_[0] eq 'NONFATAL' );
1013
1014     # Empty @_ is equivalent to @_ = 'all' ;
1015     ${^WARNING_BITS} = @_ ? _bits($mask, @_) : $mask | $Bits{all} ;
1016 }
1017
1018 sub unimport
1019 {
1020     shift;
1021
1022     my $catmask ;
1023     my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
1024
1025     if (vec($mask, $Offsets{'all'}, 1)) {
1026         $mask |= $Bits{'all'} ;
1027         $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
1028     }
1029
1030     # append 'all' when implied (empty import list or after a lone "FATAL")
1031     push @_, 'all' if !@_ || @_==1 && $_[0] eq 'FATAL';
1032
1033     foreach my $word ( @_ ) {
1034         if ($word eq 'FATAL') {
1035             next;
1036         }
1037         elsif ($catmask = $Bits{$word}) {
1038             $mask &= ~($catmask | $DeadBits{$word} | $All);
1039         }
1040         else
1041           { Croaker("Unknown warnings category '$word'")}
1042     }
1043
1044     ${^WARNING_BITS} = $mask ;
1045 }
1046
1047 my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
1048
1049 sub MESSAGE () { 4 };
1050 sub FATAL () { 2 };
1051 sub NORMAL () { 1 };
1052
1053 sub __chk
1054 {
1055     my $category ;
1056     my $offset ;
1057     my $isobj = 0 ;
1058     my $wanted = shift;
1059     my $has_message = $wanted & MESSAGE;
1060
1061     unless (@_ == 1 || @_ == ($has_message ? 2 : 0)) {
1062         my $sub = (caller 1)[3];
1063         my $syntax = $has_message ? "[category,] 'message'" : '[category]';
1064         Croaker("Usage: $sub($syntax)");
1065     }
1066
1067     my $message = pop if $has_message;
1068
1069     if (@_) {
1070         # check the category supplied.
1071         $category = shift ;
1072         if (my $type = ref $category) {
1073             Croaker("not an object")
1074                 if exists $builtin_type{$type};
1075             $category = $type;
1076             $isobj = 1 ;
1077         }
1078         $offset = $Offsets{$category};
1079         Croaker("Unknown warnings category '$category'")
1080             unless defined $offset;
1081     }
1082     else {
1083         $category = (caller(1))[0] ;
1084         $offset = $Offsets{$category};
1085         Croaker("package '$category' not registered for warnings")
1086             unless defined $offset ;
1087     }
1088
1089     my $i;
1090
1091     if ($isobj) {
1092         my $pkg;
1093         $i = 2;
1094         while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
1095             last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
1096         }
1097         $i -= 2 ;
1098     }
1099     else {
1100         $i = _error_loc(); # see where Carp will allocate the error
1101     }
1102
1103     # Default to 0 if caller returns nothing.  Default to $DEFAULT if it
1104     # explicitly returns undef.
1105     my(@callers_bitmask) = (caller($i))[9] ;
1106     my $callers_bitmask =
1107          @callers_bitmask ? $callers_bitmask[0] // $DEFAULT : 0 ;
1108
1109     my @results;
1110     foreach my $type (FATAL, NORMAL) {
1111         next unless $wanted & $type;
1112
1113         push @results, (vec($callers_bitmask, $offset + $type - 1, 1) ||
1114                         vec($callers_bitmask, $Offsets{'all'} + $type - 1, 1));
1115     }
1116
1117     # &enabled and &fatal_enabled
1118     return $results[0] unless $has_message;
1119
1120     # &warnif, and the category is neither enabled as warning nor as fatal
1121     return if $wanted == (NORMAL | FATAL | MESSAGE)
1122         && !($results[0] || $results[1]);
1123
1124     require Carp;
1125     Carp::croak($message) if $results[0];
1126     # will always get here for &warn. will only get here for &warnif if the
1127     # category is enabled
1128     Carp::carp($message);
1129 }
1130
1131 sub _mkMask
1132 {
1133     my ($bit) = @_;
1134     my $mask = "";
1135
1136     vec($mask, $bit, 1) = 1;
1137     return $mask;
1138 }
1139
1140 sub register_categories
1141 {
1142     my @names = @_;
1143
1144     for my $name (@names) {
1145         if (! defined $Bits{$name}) {
1146             $Bits{$name}     = _mkMask($LAST_BIT);
1147             vec($Bits{'all'}, $LAST_BIT, 1) = 1;
1148             $Offsets{$name}  = $LAST_BIT ++;
1149             foreach my $k (keys %Bits) {
1150                 vec($Bits{$k}, $LAST_BIT, 1) = 0;
1151             }
1152             $DeadBits{$name} = _mkMask($LAST_BIT);
1153             vec($DeadBits{'all'}, $LAST_BIT++, 1) = 1;
1154         }
1155     }
1156 }
1157
1158 sub _error_loc {
1159     require Carp;
1160     goto &Carp::short_error_loc; # don't introduce another stack frame
1161 }
1162
1163 sub enabled
1164 {
1165     return __chk(NORMAL, @_);
1166 }
1167
1168 sub fatal_enabled
1169 {
1170     return __chk(FATAL, @_);
1171 }
1172
1173 sub warn
1174 {
1175     return __chk(FATAL | MESSAGE, @_);
1176 }
1177
1178 sub warnif
1179 {
1180     return __chk(NORMAL | FATAL | MESSAGE, @_);
1181 }
1182
1183 # These are not part of any public interface, so we can delete them to save
1184 # space.
1185 delete @warnings::{qw(NORMAL FATAL MESSAGE)};
1186
1187 1;
1188
1189 # ex: set ro: