X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/c29314de3abdb1d3bc527cce15a8f014a87875da..d43328d502ac91c4d98e218d0721cd5f3bcd3950:/regen/warnings.pl

diff --git a/regen/warnings.pl b/regen/warnings.pl
index cd957f6..5721c17 100644
--- a/regen/warnings.pl
+++ b/regen/warnings.pl
@@ -16,10 +16,10 @@
 #
 # 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 ;
@@ -105,6 +105,8 @@ my $tree = {
                                     [ 5.021, DEFAULT_ON ],
                                 'experimental::bitwise' =>
                                     [ 5.021, DEFAULT_ON ],
+                                'experimental::declared_refs' =>
+                                    [ 5.025, DEFAULT_ON ],
                         }],
 
         'missing'       => [ 5.021, DEFAULT_OFF],
@@ -358,8 +360,10 @@ EOM
 
   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))
@@ -369,6 +373,64 @@ EOM
     : (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
@@ -400,7 +462,8 @@ EOM
 #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)) ||	\
@@ -414,6 +477,13 @@ EOM
 }
 
 while (<DATA>) {
+    last if /^VERSION$/ ;
+    print $pm $_ ;
+}
+
+print $pm qq(our \$VERSION = "$::VERSION";\n);
+
+while (<DATA>) {
     last if /^KEYWORDS$/ ;
     print $pm $_ ;
 }
@@ -463,7 +533,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(@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 (<DATA>) {
@@ -479,14 +549,15 @@ read_only_bottom_close_and_rename($pm);
 __END__
 package warnings;
 
-our $VERSION = '1.33';
+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
 
@@ -1137,8 +1208,10 @@ this snippet of code:
     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(@_);
     }