# Regenerate (overwriting only if changed):
#
# lib/warnings.pm
+# pod/perllexwarn.pod
# warnings.h
#
# from information hardcoded into this script (the $tree hash), plus the
-# template for warnings.pm in the DATA section.
+# template for warnings.pm in the DATA section. Only part of
+# pod/perllexwarn.pod (the warnings category hierarchy) is generated,
+# the other parts remaining untouched.
#
# When changing the number of warnings, t/op/caller.t should change to
# correspond with the value of $BYTES in lib/warnings.pm
#
# This script is normally invoked from regen.pl.
-$VERSION = '1.02_03';
+$VERSION = '1.02_05';
BEGIN {
require 'regen/regen_lib.pl';
'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],
}],
'severe' => [ 5.008, {
'inplace' => [ 5.008, DEFAULT_ON],
- 'internal' => [ 5.008, DEFAULT_ON],
+ 'internal' => [ 5.008, DEFAULT_OFF],
'debugging' => [ 5.008, DEFAULT_ON],
'malloc' => [ 5.008, DEFAULT_ON],
- }],
- 'deprecated' => [ 5.008, DEFAULT_OFF],
+ }],
+ 'deprecated' => [ 5.008, DEFAULT_ON],
'void' => [ 5.008, DEFAULT_OFF],
'recursion' => [ 5.008, DEFAULT_OFF],
'redefine' => [ 5.008, DEFAULT_OFF],
'once' => [ 5.008, DEFAULT_OFF],
'misc' => [ 5.008, DEFAULT_OFF],
'regexp' => [ 5.008, DEFAULT_OFF],
- 'glob' => [ 5.008, DEFAULT_OFF],
+ 'glob' => [ 5.008, DEFAULT_ON],
'untie' => [ 5.008, DEFAULT_OFF],
'substr' => [ 5.008, DEFAULT_OFF],
'taint' => [ 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 ],
+ }],
#'default' => [ 5.008, DEFAULT_ON ],
}],
} ;
+my @def ;
my %list ;
my %Value ;
my %ValueToName ;
my ($ver, $rest) = @{ $v } ;
if (ref $rest)
{ push (@{ $list{$k} }, walk ($rest)) }
+ elsif ($rest == DEFAULT_ON)
+ { push @def, $NameToValue{uc $k} }
push @list, @{ $list{$k} } ;
}
my ($name, $version) = @{ $ValueToName{$k} };
print $warn "\n/* Warnings Categories added in Perl $version */\n\n"
if $last_ver != $version ;
- print $warn tab(5, "#define WARN_$name"), "$k\n" ;
+ $name =~ y/:/_/;
+ print $warn tab(5, "#define WARN_$name"), " $k\n" ;
$last_ver = $version ;
}
print $warn "\n" ;
char))
#define ckWARN(w) Perl_ckwarn(aTHX_ packWARN(w))
+
+/* The w1, w2 ... should be independent warnings categories; one shouldn't be
+ * a subcategory of any other */
+
#define ckWARN2(w1,w2) Perl_ckwarn(aTHX_ packWARN2(w1,w2))
#define ckWARN3(w1,w2,w3) Perl_ckwarn(aTHX_ packWARN3(w1,w2,w3))
#define ckWARN4(w1,w2,w3,w4) Perl_ckwarn(aTHX_ packWARN4(w1,w2,w3,w4))
#define WARNshift 8
#define packWARN(a) (a )
+
+/* The a, b, ... should be independent warnings categories; one shouldn't be
+ * a subcategory of any other */
+
#define packWARN2(a,b) ((a) | ((b)<<8) )
#define packWARN3(a,b,c) ((a) | ((b)<<8) | ((c)<<16) )
#define packWARN4(a,b,c,d) ((a) | ((b)<<8) | ((c)<<16) | ((d) <<24))
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" ;
while (<DATA>) {
read_only_bottom_close_and_rename($pm);
+my $lexwarn = open_new 'pod/perllexwarn.pod', '>';
+open my $oldlexwarn, "pod/perllexwarn.pod"
+ or die "$0 cannot open pod/perllexwarn.pod for reading: $!";
+select +(select($lexwarn), do {
+ while(<$oldlexwarn>) {
+ print;
+ last if /=for warnings.pl begin/;
+ }
+ print "\n";
+ printTree($tree, " ") ;
+ print "\n";
+ while(<$oldlexwarn>) {
+ last if /=for warnings.pl end/;
+ }
+ do { print } while <$oldlexwarn>;
+})[0];
+
+close_and_rename($lexwarn);
+
__END__
package warnings;
-our $VERSION = '1.12';
+our $VERSION = '1.20';
# Verify that we're called correctly so that warnings will work.
# see also strict.pm.
The C<warnings> pragma is a replacement for the command line flag C<-w>,
but the pragma is limited to the enclosing block, while the flag is global.
-See L<perllexwarn> for more information.
+See L<perllexwarn> for more information and the list of built-in warning
+categories.
If no import list is supplied, all possible warnings are either enabled
or disabled.
{
shift;
- my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $NONE) ;
+ my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
if (vec($mask, $Offsets{'all'}, 1)) {
$mask |= $Bits{'all'} ;
shift;
my $catmask ;
- my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $NONE) ;
+ my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ;
if (vec($mask, $Offsets{'all'}, 1)) {
$mask |= $Bits{'all'} ;
$i = _error_loc(); # see where Carp will allocate the error
}
- # Defaulting this to 0 reduces complexity in code paths below.
- my $callers_bitmask = (caller($i))[9] || 0 ;
+ # Default to 0 if caller returns nothing. Default to $DEFAULT if it
+ # explicitly returns undef.
+ my(@callers_bitmask) = (caller($i))[9] ;
+ my $callers_bitmask =
+ @callers_bitmask ? $callers_bitmask[0] // $DEFAULT : 0 ;
my @results;
foreach my $type (FATAL, NORMAL) {
# These are not part of any public interface, so we can delete them to save
# space.
-delete $warnings::{$_} foreach qw(NORMAL FATAL MESSAGE);
+delete @warnings::{qw(NORMAL FATAL MESSAGE)};
1;
https://perl5.git.perl.org / perl5.git / blobdiff