X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/4bbd41f5cf100c72f174c530ef146ca94952a289..0afc88d2cf06c423122bf95d61d95a64fb207815:/regen/warnings.pl diff --git a/regen/warnings.pl b/regen/warnings.pl index 8b7ac2c..58312ca 100644 --- a/regen/warnings.pl +++ b/regen/warnings.pl @@ -16,7 +16,7 @@ # # This script is normally invoked from regen.pl. -$VERSION = '1.42'; +$VERSION = '1.48'; BEGIN { require './regen/regen_lib.pl'; @@ -111,6 +111,14 @@ my $tree = { [ 5.027, DEFAULT_ON ], 'experimental::alpha_assertions' => [ 5.027, DEFAULT_ON ], + 'experimental::private_use' => + [ 5.029, DEFAULT_ON ], + 'experimental::uniprop_wildcards' => + [ 5.029, DEFAULT_ON ], + 'experimental::vlb' => + [ 5.029, DEFAULT_ON ], + 'experimental::isa' => + [ 5.031, DEFAULT_ON ], }], 'missing' => [ 5.021, DEFAULT_OFF], @@ -197,15 +205,15 @@ sub walk sub mkRange { - my @a = @_ ; - my @out = @a ; + my @in = @_ ; + my @out = @in ; - for my $i (1 .. @a - 1) { + for my $i (1 .. @in - 1) { $out[$i] = ".." - if $a[$i] == $a[$i - 1] + 1 - && ($i >= @a - 1 || $a[$i] + 1 == $a[$i + 1] ); + if $in[$i] == $in[$i - 1] + 1 + && ($i >= @in - 1 || $in[$i] + 1 == $in[$i + 1] ); } - $out[-1] = $a[-1] if $out[-1] eq ".."; + $out[-1] = $in[-1] if $out[-1] eq ".."; my $out = join(",",@out); @@ -259,11 +267,11 @@ sub warningsTree sub mkHexOct { - my ($f, $max, @a) = @_ ; + my ($f, $max, @bits) = @_ ; my $mask = "\x00" x $max ; my $string = "" ; - foreach (@a) { + foreach (@bits) { vec($mask, $_, 1) = 1 ; } @@ -280,14 +288,14 @@ sub mkHexOct sub mkHex { - my($max, @a) = @_; - return mkHexOct("x", $max, @a); + my($max, @bits) = @_; + return mkHexOct("x", $max, @bits); } sub mkOct { - my($max, @a) = @_; - return mkHexOct("o", $max, @a); + my($max, @bits) = @_; + return mkHexOct("o", $max, @bits); } ########################################################################### @@ -322,8 +330,8 @@ my ($index, $warn_size); #define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF) #define pWARN_STD NULL -#define pWARN_ALL (((STRLEN*)0)+1) /* use warnings 'all' */ -#define pWARN_NONE (((STRLEN*)0)+2) /* no warnings 'all' */ +#define pWARN_ALL (STRLEN *) &PL_WARN_ALL /* use warnings 'all' */ +#define pWARN_NONE (STRLEN *) &PL_WARN_NONE /* no warnings 'all' */ #define specialWARN(x) ((x) == pWARN_STD || (x) == pWARN_ALL || \ (x) == pWARN_NONE) @@ -352,15 +360,21 @@ EOM my $k ; my $last_ver = 0; + my @names; foreach $k (sort { $a <=> $b } keys %ValueToName) { my ($name, $version) = @{ $ValueToName{$k} }; print $warn "\n/* Warnings Categories added in Perl $version */\n\n" if $last_ver != $version ; $name =~ y/:/_/; - print $warn tab(6, "#define WARN_$name"), " $k\n" ; + $name = "WARN_$name"; + print $warn tab(6, "#define $name"), " $k\n" ; + push @names, $name; $last_ver = $version ; } - print $warn "\n" ; + print $warn "\n\n/*\n" ; + + print $warn map { "=for apidoc Amnh||$_\n" } @names; + print $warn "\n=cut\n*/\n\n" ; print $warn tab(6, '#define WARNsize'), " $warn_size\n" ; print $warn tab(6, '#define WARN_ALLstring'), ' "', ('\125' x $warn_size) , "\"\n" ; @@ -376,64 +390,45 @@ EOM #define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x))) #define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1)) -#define DUP_WARNINGS(p) \ - (specialWARN(p) ? (STRLEN*)(p) \ - : (STRLEN*)CopyD(p, PerlMemShared_malloc(sizeof(*p)+*p), sizeof(*p)+*p, \ - char)) +#define DUP_WARNINGS(p) Perl_dup_warnings(aTHX_ p) + +#define free_and_set_cop_warnings(cmp,w) STMT_START { \ + if (!specialWARN((cmp)->cop_warnings)) PerlMemShared_free((cmp)->cop_warnings); \ + (cmp)->cop_warnings = w; \ +} STMT_END /* =head1 Warning and Dieing -=for apidoc Am|bool|ckWARN|U32 w +In all these calls, the C> parameters are warning category +constants. You can see the ones currently available in +L, just capitalize all letters in the names +and prefix them by C. So, for example, the category C used in a +perl program becomes C when used in XS code and passed to one of +the calls below. -Returns a boolean as to whether or not warnings are enabled for the warning -category C. If the category is by default enabled even if not within the -scope of S>, instead use the L macro. - -=for apidoc Am|bool|ckWARN_d|U32 w - -Like C>, but for use if and only if the warning category is by -default enabled even if not within the scope of S>. +=for apidoc Am|bool|ckWARN|U32 w +=for apidoc_item ||ckWARN2|U32 w1|U32 w2 +=for apidoc_item ||ckWARN3|U32 w1|U32 w2|U32 w3 +=for apidoc_item ||ckWARN4|U32 w1|U32 w2|U32 w3|U32 w4 +These return a boolean as to whether or not warnings are enabled for any of +the warning category(ies) parameters: C, C, .... -=for apidoc Am|bool|ckWARN2|U32 w1|U32 w2 +Should any of the categories by default be enabled even if not within the +scope of S>, instead use the C> macros. -Like C>, 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>, instead use the L -macro. The categories must be completely independent, one may not be -subclassed from the other. +The categories must be completely independent, one may not be subclassed from +the other. -=for apidoc Am|bool|ckWARN2_d|U32 w1|U32 w2 +=for apidoc Am|bool|ckWARN_d|U32 w +=for apidoc_item ckWARN2_d|U32 w1|U32 w2 +=for apidoc_item ckWARN3_d|U32 w1|U32 w2|U32 w3 +=for apidoc_item ckWARN4_d|U32 w1|U32 w2|U32 w3|U32 w4 -Like C>, but for use if and only if either warning category is by +Like C>, but for use if and only if the warning category(ies) is by default enabled even if not within the scope of S>. -=for apidoc Am|bool|ckWARN3|U32 w1|U32 w2|U32 w3 - -Like C>, 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>, instead use the L -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>, but for use if and only if any of the warning categories -is by default enabled even if not within the scope of S>. - -=for apidoc Am|bool|ckWARN4|U32 w1|U32 w2|U32 w3|U32 w4 - -Like C>, 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>, instead use the L -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>, but for use if and only if any of the warning categories -is by default enabled even if not within the scope of S>. =cut @@ -543,7 +538,7 @@ 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" ; + '"; # [', 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 () { @@ -589,10 +584,10 @@ sub _expand_bits { } elsif ($len > $want_len) { substr $bits, $want_len, $len-$want_len, ""; } else { - my $a = vec($bits, $Offsets{all} >> 1, 2); - $a |= $a << 2; - $a |= $a << 4; - $bits .= chr($a) x ($want_len - $len); + my $x = vec($bits, $Offsets{all} >> 1, 2); + $x |= $x << 2; + $x |= $x << 4; + $bits .= chr($x) x ($want_len - $len); } } return $bits; @@ -920,17 +915,17 @@ Similarly all warnings are disabled in a block by either of these: For example, consider the code below: use warnings; - my @a; + my @x; { no warnings; - my $b = @a[0]; + my $y = @x[0]; } - my $c = @a[0]; + my $z = @x[0]; The code in the enclosing block has warnings enabled, but the inner block has them disabled. In this case that means the assignment to the -scalar C<$c> will trip the C<"Scalar value @a[0] better written as $a[0]"> -warning, but the assignment to the scalar C<$b> will not. +scalar C<$z> will trip the C<"Scalar value @x[0] better written as $x[0]"> +warning, but the assignment to the scalar C<$y> will not. =head2 Default Warnings and Optional Warnings @@ -942,18 +937,18 @@ would get a warning whether you wanted it or not. For example, the code below would always produce an C<"isn't numeric"> warning about the "2:". - my $a = "2:" + 3; + my $x = "2:" + 3; With the introduction of lexical warnings, mandatory warnings now become I warnings. The difference is that although the previously mandatory warnings are still enabled by default, they can then be subsequently enabled or disabled with the lexical warning pragma. For example, in the code below, an C<"isn't numeric"> warning will only -be reported for the C<$a> variable. +be reported for the C<$x> variable. - my $a = "2:" + 3; + my $x = "2:" + 3; no warnings; - my $b = "2:" + 3; + my $y = "2:" + 3; Note that neither the B<-w> flag or the C<$^W> can be used to disable/enable default warnings. They are still mandatory in this case. @@ -973,22 +968,26 @@ a block of code. You might expect this to be enough to do the trick: { local ($^W) = 0; - my $a =+ 2; - my $b; chop $b; + my $x =+ 2; + my $y; chop $y; } When this code is run with the B<-w> flag, a warning will be produced -for the C<$a> line: C<"Reversed += operator">. +for the C<$x> line: C<"Reversed += operator">. The problem is that Perl has both compile-time and run-time warnings. To disable compile-time warnings you need to rewrite the code like this: { BEGIN { $^W = 0 } - my $a =+ 2; - my $b; chop $b; + my $x =+ 2; + my $y; chop $y; } +And note that unlike the first example, this will permanently set C<$^W> +since it cannot both run during compile-time and be localized to a +run-time block. + The other big problem with C<$^W> is the way you can inadvertently change the warning setting in unexpected places in your code. For example, when the code below is run (without the B<-w> flag), the second call @@ -997,7 +996,7 @@ the first will not. sub doit { - my $b; chop $b; + my $y; chop $y; } doit(); @@ -1023,8 +1022,8 @@ warnings are (or aren't) produced: X<-w> This is the existing flag. If the lexical warnings pragma is B -used in any of you code, or any of the modules that you use, this flag -will enable warnings everywhere. See L for +used in any of your code, or any of the modules that you use, this flag +will enable warnings everywhere. See L for details of how this flag interacts with lexical warnings. =item B<-W> @@ -1365,12 +1364,12 @@ C. use Original; use Derived; use warnings 'Derived'; - my $a = Original->new(); - $a->doit(1); - my $b = Derived->new(); - $a->doit(1); + my $x = Original->new(); + $x->doit(1); + my $y = Derived->new(); + $x->doit(1); -When this code is run only the C object, C<$b>, will generate +When this code is run only the C object, C<$y>, will generate a warning. Odd numbers are unsafe at main.pl line 7