#
# This script is normally invoked from regen.pl.
-$VERSION = '1.03';
+$VERSION = '1.37';
BEGIN {
- require 'regen/regen_lib.pl';
+ require './regen/regen_lib.pl';
push @INC, './lib';
}
use strict ;
sub DEFAULT_OFF () { 2 }
my $tree = {
-
'all' => [ 5.008, {
- 'io' => [ 5.008, {
- 'pipe' => [ 5.008, DEFAULT_OFF],
- 'unopened' => [ 5.008, DEFAULT_OFF],
- 'closed' => [ 5.008, DEFAULT_OFF],
- 'newline' => [ 5.008, DEFAULT_OFF],
- 'exec' => [ 5.008, DEFAULT_OFF],
- 'layer' => [ 5.008, DEFAULT_OFF],
- 'syscalls' => [ 5.019, DEFAULT_OFF],
- }],
- 'syntax' => [ 5.008, {
- 'ambiguous' => [ 5.008, DEFAULT_OFF],
- 'semicolon' => [ 5.008, DEFAULT_OFF],
- 'precedence' => [ 5.008, DEFAULT_OFF],
- 'bareword' => [ 5.008, DEFAULT_OFF],
- 'reserved' => [ 5.008, DEFAULT_OFF],
- 'digit' => [ 5.008, DEFAULT_OFF],
- 'parenthesis' => [ 5.008, DEFAULT_OFF],
- 'printf' => [ 5.008, DEFAULT_OFF],
- 'prototype' => [ 5.008, DEFAULT_OFF],
- 'qw' => [ 5.008, DEFAULT_OFF],
+ 'io' => [ 5.008, {
+ 'pipe' => [ 5.008, DEFAULT_OFF],
+ 'unopened' => [ 5.008, DEFAULT_OFF],
+ 'closed' => [ 5.008, DEFAULT_OFF],
+ 'newline' => [ 5.008, DEFAULT_OFF],
+ 'exec' => [ 5.008, DEFAULT_OFF],
+ 'layer' => [ 5.008, DEFAULT_OFF],
+ 'syscalls' => [ 5.019, DEFAULT_OFF],
+ }],
+ 'syntax' => [ 5.008, {
+ 'ambiguous' => [ 5.008, DEFAULT_OFF],
+ 'semicolon' => [ 5.008, DEFAULT_OFF],
+ 'precedence' => [ 5.008, DEFAULT_OFF],
+ 'bareword' => [ 5.008, DEFAULT_OFF],
+ 'reserved' => [ 5.008, DEFAULT_OFF],
+ 'digit' => [ 5.008, DEFAULT_OFF],
+ 'parenthesis' => [ 5.008, DEFAULT_OFF],
+ 'printf' => [ 5.008, DEFAULT_OFF],
+ 'prototype' => [ 5.008, DEFAULT_OFF],
+ 'qw' => [ 5.008, DEFAULT_OFF],
'illegalproto' => [ 5.011, DEFAULT_OFF],
- }],
- 'severe' => [ 5.008, {
- 'inplace' => [ 5.008, DEFAULT_ON],
- 'internal' => [ 5.008, DEFAULT_OFF],
- 'debugging' => [ 5.008, DEFAULT_ON],
- 'malloc' => [ 5.008, DEFAULT_ON],
- }],
- 'deprecated' => [ 5.008, DEFAULT_ON],
- 'void' => [ 5.008, DEFAULT_OFF],
- 'recursion' => [ 5.008, DEFAULT_OFF],
- 'redefine' => [ 5.008, DEFAULT_OFF],
- 'numeric' => [ 5.008, DEFAULT_OFF],
- 'uninitialized' => [ 5.008, DEFAULT_OFF],
- 'once' => [ 5.008, DEFAULT_OFF],
- 'misc' => [ 5.008, DEFAULT_OFF],
- 'regexp' => [ 5.008, DEFAULT_OFF],
- 'glob' => [ 5.008, DEFAULT_ON],
- 'untie' => [ 5.008, DEFAULT_OFF],
- 'substr' => [ 5.008, DEFAULT_OFF],
- 'taint' => [ 5.008, DEFAULT_OFF],
- 'signal' => [ 5.008, DEFAULT_OFF],
- 'closure' => [ 5.008, DEFAULT_OFF],
- 'overflow' => [ 5.008, DEFAULT_OFF],
- 'portable' => [ 5.008, DEFAULT_OFF],
- 'utf8' => [ 5.008, {
+ }],
+ 'severe' => [ 5.008, {
+ 'inplace' => [ 5.008, DEFAULT_ON],
+ 'internal' => [ 5.008, DEFAULT_OFF],
+ 'debugging' => [ 5.008, DEFAULT_ON],
+ 'malloc' => [ 5.008, DEFAULT_ON],
+ }],
+ 'deprecated' => [ 5.008, DEFAULT_ON],
+ 'void' => [ 5.008, DEFAULT_OFF],
+ 'recursion' => [ 5.008, DEFAULT_OFF],
+ 'redefine' => [ 5.008, DEFAULT_OFF],
+ 'numeric' => [ 5.008, DEFAULT_OFF],
+ 'uninitialized' => [ 5.008, DEFAULT_OFF],
+ 'once' => [ 5.008, DEFAULT_OFF],
+ 'misc' => [ 5.008, DEFAULT_OFF],
+ 'regexp' => [ 5.008, DEFAULT_OFF],
+ 'glob' => [ 5.008, DEFAULT_ON],
+ 'untie' => [ 5.008, DEFAULT_OFF],
+ 'substr' => [ 5.008, DEFAULT_OFF],
+ 'taint' => [ 5.008, DEFAULT_OFF],
+ 'signal' => [ 5.008, DEFAULT_OFF],
+ 'closure' => [ 5.008, DEFAULT_OFF],
+ 'overflow' => [ 5.008, DEFAULT_OFF],
+ 'portable' => [ 5.008, DEFAULT_OFF],
+ 'utf8' => [ 5.008, {
'surrogate' => [ 5.013, DEFAULT_OFF],
'nonchar' => [ 5.013, DEFAULT_OFF],
'non_unicode' => [ 5.013, DEFAULT_OFF],
}],
- 'exiting' => [ 5.008, DEFAULT_OFF],
- 'pack' => [ 5.008, DEFAULT_OFF],
- 'unpack' => [ 5.008, DEFAULT_OFF],
- 'threads' => [ 5.008, DEFAULT_OFF],
- 'imprecision' => [ 5.011, DEFAULT_OFF],
- 'experimental' => [ 5.017, {
+ 'exiting' => [ 5.008, DEFAULT_OFF],
+ 'pack' => [ 5.008, DEFAULT_OFF],
+ 'unpack' => [ 5.008, DEFAULT_OFF],
+ 'threads' => [ 5.008, DEFAULT_OFF],
+ 'imprecision' => [ 5.011, DEFAULT_OFF],
+ 'experimental' => [ 5.017, {
'experimental::lexical_subs' =>
[ 5.017, DEFAULT_ON ],
'experimental::regex_sets' =>
[ 5.017, DEFAULT_ON ],
- 'experimental::lexical_topic' =>
- [ 5.017, DEFAULT_ON ],
'experimental::smartmatch' =>
[ 5.017, DEFAULT_ON ],
'experimental::postderef' =>
[ 5.019, DEFAULT_ON ],
- 'experimental::autoderef' =>
- [ 5.019, DEFAULT_ON ],
'experimental::signatures' =>
[ 5.019, DEFAULT_ON ],
'experimental::win32_perlio' =>
[ 5.021, DEFAULT_ON ],
'experimental::refaliasing' =>
[ 5.021, DEFAULT_ON ],
+ 'experimental::re_strict' =>
+ [ 5.021, DEFAULT_ON ],
+ 'experimental::const_attr' =>
+ [ 5.021, DEFAULT_ON ],
+ 'experimental::bitwise' =>
+ [ 5.021, DEFAULT_ON ],
+ 'experimental::declared_refs' =>
+ [ 5.025, DEFAULT_ON ],
}],
- 'missing' => [ 5.021, DEFAULT_OFF],
- 'redundant' => [ 5.021, DEFAULT_OFF],
+ 'missing' => [ 5.021, DEFAULT_OFF],
+ 'redundant' => [ 5.021, DEFAULT_OFF],
+ 'locale' => [ 5.021, DEFAULT_ON],
- #'default' => [ 5.008, DEFAULT_ON ],
- }],
-} ;
+ #'default' => [ 5.008, DEFAULT_ON ],
+}]};
my @def ;
my %list ;
print $warn "\n/* Warnings Categories added in Perl $version */\n\n"
if $last_ver != $version ;
$name =~ y/:/_/;
- print $warn tab(5, "#define WARN_$name"), " $k\n" ;
+ print $warn tab(6, "#define WARN_$name"), " $k\n" ;
$last_ver = $version ;
}
print $warn "\n" ;
- print $warn tab(5, '#define WARNsize'), "$warn_size\n" ;
- print $warn tab(5, '#define WARN_ALLstring'), '"', ('\125' x $warn_size) , "\"\n" ;
- print $warn tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) , "\"\n" ;
+ print $warn tab(6, '#define WARNsize'), " $warn_size\n" ;
+ print $warn tab(6, '#define WARN_ALLstring'), ' "', ('\125' x $warn_size) , "\"\n" ;
+ print $warn tab(6, '#define WARN_NONEstring'), ' "', ('\0' x $warn_size) , "\"\n" ;
print $warn <<'EOM';
-#define isLEXWARN_on (PL_curcop->cop_warnings != pWARN_STD)
-#define isLEXWARN_off (PL_curcop->cop_warnings == pWARN_STD)
+#define isLEXWARN_on \
+ cBOOL(PL_curcop && PL_curcop->cop_warnings != pWARN_STD)
+#define isLEXWARN_off \
+ cBOOL(!PL_curcop || PL_curcop->cop_warnings == pWARN_STD)
#define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE))
#define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)))
#define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1))
: (STRLEN*)CopyD(p, PerlMemShared_malloc(sizeof(*p)+*p), sizeof(*p)+*p, \
char))
+/*
+
+=head1 Warning and Dieing
+
+=for apidoc Am|bool|ckWARN|U32 w
+
+Returns a boolean as to whether or not warnings are enabled for the warning
+category C<w>. If the category is by default enabled even if not within the
+scope of S<C<use warnings>>, instead use the L</ckWARN_d> macro.
+
+=for apidoc Am|bool|ckWARN_d|U32 w
+
+Like C<L</ckWARN>>, but for use if and only if the warning category is by
+default enabled even if not within the scope of S<C<use warnings>>.
+
+=for apidoc Am|bool|ckWARN2|U32 w1|U32 w2
+
+Like C<L</ckWARN>>, but takes two warnings categories as input, and returns
+TRUE if either is enabled. If either category is by default enabled even if
+not within the scope of S<C<use warnings>>, instead use the L</ckWARN2_d>
+macro. The categories must be completely independent, one may not be
+subclassed from the other.
+
+=for apidoc Am|bool|ckWARN2_d|U32 w1|U32 w2
+
+Like C<L</ckWARN2>>, but for use if and only if either warning category is by
+default enabled even if not within the scope of S<C<use warnings>>.
+
+=for apidoc Am|bool|ckWARN3|U32 w1|U32 w2|U32 w3
+
+Like C<L</ckWARN2>>, but takes three warnings categories as input, and returns
+TRUE if any is enabled. If any of the categories is by default enabled even
+if not within the scope of S<C<use warnings>>, instead use the L</ckWARN3_d>
+macro. The categories must be completely independent, one may not be
+subclassed from any other.
+
+=for apidoc Am|bool|ckWARN3_d|U32 w1|U32 w2|U32 w3
+
+Like C<L</ckWARN3>>, but for use if and only if any of the warning categories
+is by default enabled even if not within the scope of S<C<use warnings>>.
+
+=for apidoc Am|bool|ckWARN4|U32 w1|U32 w2|U32 w3|U32 w4
+
+Like C<L</ckWARN3>>, but takes four warnings categories as input, and returns
+TRUE if any is enabled. If any of the categories is by default enabled even
+if not within the scope of S<C<use warnings>>, instead use the L</ckWARN4_d>
+macro. The categories must be completely independent, one may not be
+subclassed from any other.
+
+=for apidoc Am|bool|ckWARN4_d|U32 w1|U32 w2|U32 w3|U32 w4
+
+Like C<L</ckWARN4>>, but for use if and only if any of the warning categories
+is by default enabled even if not within the scope of S<C<use warnings>>.
+
+=cut
+
+*/
+
#define ckWARN(w) Perl_ckwarn(aTHX_ packWARN(w))
/* The w1, w2 ... should be independent warnings categories; one shouldn't be
#define unpackWARN4(x) (((x) >>24) & 0xFF)
#define ckDEAD(x) \
- ( ! specialWARN(PL_curcop->cop_warnings) && \
+ (PL_curcop && \
+ !specialWARN(PL_curcop->cop_warnings) && \
( isWARNf_on(PL_curcop->cop_warnings, WARN_ALL) || \
isWARNf_on(PL_curcop->cop_warnings, unpackWARN1(x)) || \
isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) || \
}
while (<DATA>) {
+ last if /^VERSION$/ ;
+ print $pm $_ ;
+}
+
+print $pm qq(our \$VERSION = "$::VERSION";\n);
+
+while (<DATA>) {
last if /^KEYWORDS$/ ;
print $pm $_ ;
}
my $last_ver = 0;
-print $pm "our %Offsets = (\n" ;
+print $pm "our %Offsets = (" ;
foreach my $k (sort { $a <=> $b } keys %ValueToName) {
my ($name, $version) = @{ $ValueToName{$k} };
$name = lc $name;
$k *= 2 ;
if ( $last_ver != $version ) {
print $pm "\n";
- print $pm tab(4, " # Warnings Categories added in Perl $version");
- print $pm "\n\n";
+ print $pm tab(6, " # Warnings Categories added in Perl $version");
+ print $pm "\n";
}
- print $pm tab(4, " '$name'"), "=> $k,\n" ;
+ print $pm tab(6, " '$name'"), "=> $k,\n" ;
$last_ver = $version;
}
-print $pm " );\n\n" ;
+print $pm ");\n\n" ;
print $pm "our %Bits = (\n" ;
foreach my $k (sort keys %list) {
my $v = $list{$k} ;
my @list = sort { $a <=> $b } @$v ;
- print $pm tab(4, " '$k'"), '=> "',
+ print $pm tab(6, " '$k'"), '=> "',
mkHex($warn_size, map $_ * 2 , @list),
'", # [', mkRange(@list), "]\n" ;
}
-print $pm " );\n\n" ;
+print $pm ");\n\n" ;
print $pm "our %DeadBits = (\n" ;
foreach my $k (sort keys %list) {
my $v = $list{$k} ;
my @list = sort { $a <=> $b } @$v ;
- print $pm tab(4, " '$k'"), '=> "',
+ print $pm tab(6, " '$k'"), '=> "',
mkHex($warn_size, map $_ * 2 + 1 , @list),
'", # [', mkRange(@list), "]\n" ;
}
-print $pm " );\n\n" ;
-print $pm '$NONE = "', ('\0' x $warn_size) , "\";\n" ;
-print $pm '$DEFAULT = "', mkHex($warn_size, map $_ * 2, @def),
- '", # [', mkRange(@def), "]\n" ;
-print $pm '$LAST_BIT = ' . "$index ;\n" ;
-print $pm '$BYTES = ' . "$warn_size ;\n" ;
+print $pm ");\n\n" ;
+print $pm "# These are used by various things, including our own tests\n";
+print $pm tab(6, 'our $NONE'), '= "', ('\0' x $warn_size) , "\";\n" ;
+print $pm tab(6, 'our $DEFAULT'), '= "', mkHex($warn_size, map $_ * 2, @def),
+ '", # [', mkRange(sort { $a <=> $b } @def), "]\n" ;
+print $pm tab(6, 'our $LAST_BIT'), '= ' . "$index ;\n" ;
+print $pm tab(6, 'our $BYTES'), '= ' . "$warn_size ;\n" ;
while (<DATA>) {
if ($_ eq "=for warnings.pl tree-goes-here\n") {
print $pm warningsTree($tree, " ");
__END__
package warnings;
-our $VERSION = '1.28';
+VERSION
# Verify that we're called correctly so that warnings will work.
+# Can't use Carp, since Carp uses us!
+# String regexps because constant folding = smaller optree = less memory vs regexp literal
# see also strict.pm.
-unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) {
- my (undef, $f, $l) = caller;
- die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n");
-}
+die sprintf "Incorrect use of pragma '%s' at %s line %d.\n", __PACKAGE__, +(caller)[1,2]
+ if __FILE__ !~ ( '(?x) \b '.__PACKAGE__.' \.pmc? \z' )
+ && __FILE__ =~ ( '(?x) \b (?i:'.__PACKAGE__.') \.pmc? \z' );
KEYWORDS
-$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
+our $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
sub Croaker
{
=head2 Fatal Warnings
X<warning, fatal>
-The presence of the word "FATAL" in the category list will escalate any
-warnings detected from the categories specified in the lexical scope
-into fatal errors. In the code below, the use of C<time>, C<length>
+The presence of the word "FATAL" in the category list will escalate
+warnings in those categories into fatal errors in that lexical scope.
+
+B<NOTE:> FATAL warnings should be used with care, particularly
+C<< FATAL => 'all' >>.
+
+Libraries using L<warnings::warn|/FUNCTIONS> for custom warning categories
+generally don't expect L<warnings::warn|/FUNCTIONS> to be fatal and can wind up
+in an unexpected state as a result. For XS modules issuing categorized
+warnings, such unanticipated exceptions could also expose memory leak bugs.
+
+Moreover, the Perl interpreter itself has had serious bugs involving
+fatalized warnings. For a summary of resolved and unresolved problems as
+of January 2015, please see
+L<this perl5-porters post|http://www.nntp.perl.org/group/perl.perl5.porters/2015/01/msg225235.html>.
+
+While some developers find fatalizing some warnings to be a useful
+defensive programming technique, using C<< FATAL => 'all' >> to fatalize
+all possible warning categories -- including custom ones -- is particularly
+risky. Therefore, the use of C<< FATAL => 'all' >> is
+L<discouraged|perlpolicy/discouraged>.
+
+The L<strictures|strictures/VERSION-2> module on CPAN offers one example of
+a warnings subset that the module's authors believe is relatively safe to
+fatalize.
+
+B<NOTE:> users of FATAL warnings, especially those using
+C<< FATAL => 'all' >>, should be fully aware that they are risking future
+portability of their programs by doing so. Perl makes absolutely no
+commitments to not introduce new warnings or warnings categories in the
+future; indeed, we explicitly reserve the right to do so. Code that may
+not warn now may warn in a future release of Perl if the Perl5 development
+team deems it in the best interests of the community to do so. Should code
+using FATAL warnings break due to the introduction of a new warning we will
+NOT consider it an incompatible change. Users of FATAL warnings should
+take special caution during upgrades to check to see if their code triggers
+any new warnings and should pay particular attention to the fine print of
+the documentation of the features they use to ensure they do not exploit
+features that are documented as risky, deprecated, or unspecified, or where
+the documentation says "so don't do that", or anything with the same sense
+and spirit. Use of such features in combination with FATAL warnings is
+ENTIRELY AT THE USER'S RISK.
+
+The following documentation describes how to use FATAL warnings but the
+perl5 porters strongly recommend that you understand the risks before doing
+so, especially for library code intended for use by others, as there is no
+way for downstream users to change the choice of fatal categories.
+
+In the code below, the use of C<time>, C<length>
and C<join> can all produce a C<"Useless use of xxx in void context">
warning.
C<< no warnings 'FATAL'; >> was unspecified; they did not behave as if
they included the C<< => 'all' >> portion. As of 5.20, they do.)
-B<NOTE:> Users of FATAL warnings, especially
-those using C<< FATAL => 'all' >>
-should be fully aware that they are risking future portability of their
-programs by doing so. Perl makes absolutely no commitments to not
-introduce new warnings, or warnings categories in the future, and indeed
-we explicitly reserve the right to do so. Code that may not warn now may
-warn in a future release of Perl if the Perl5 development team deems it
-in the best interests of the community to do so. Should code using FATAL
-warnings break due to the introduction of a new warning we will NOT
-consider it an incompatible change. Users of FATAL warnings should take
-special caution during upgrades to check to see if their code triggers
-any new warnings and should pay particular attention to the fine print of
-the documentation of the features they use to ensure they do not exploit
-features that are documented as risky, deprecated, or unspecified, or where
-the documentation says "so don't do that", or anything with the same sense
-and spirit. Use of such features in combination with FATAL warnings is
-ENTIRELY AT THE USER'S RISK.
-
=head2 Reporting Warnings from a Module
X<warning, reporting> X<warning, registering>
package MyMod::Abc;
sub open {
- warnings::warnif("deprecated",
- "open is deprecated, use new instead");
+ if (warnings::enabled("deprecated")) {
+ warnings::warn("deprecated",
+ "open is deprecated, use new instead");
+ }
new(@_);
}
https://perl5.git.perl.org / perl5.git / blobdiff