This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Increase $warnings::VERSION to 1.15
[perl5.git] / regen / warnings.pl
diff --git a/regen/warnings.pl b/regen/warnings.pl
index b3e1c04..e99ff4b 100644 (file)
--- a/regen/warnings.pl
+++ b/regen/warnings.pl
@@ -53,11 +53,11 @@ my $tree = {
                           }],
                'severe'        => [ 5.008, {   
                                'inplace'       => [ 5.008, DEFAULT_ON],
                           }],
                '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],
                           }],
                                '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],
                'void'          => [ 5.008, DEFAULT_OFF],
                'recursion'     => [ 5.008, DEFAULT_OFF],
                'redefine'      => [ 5.008, DEFAULT_OFF],
@@ -66,7 +66,7 @@ my $tree = {
                'once'          => [ 5.008, DEFAULT_OFF],
                'misc'          => [ 5.008, DEFAULT_OFF],
                'regexp'        => [ 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],
                'untie'         => [ 5.008, DEFAULT_OFF],
        'substr'        => [ 5.008, DEFAULT_OFF],
        'taint'         => [ 5.008, DEFAULT_OFF],
@@ -84,11 +84,16 @@ my $tree = {
                'unpack'        => [ 5.008, DEFAULT_OFF],
                'threads'       => [ 5.008, DEFAULT_OFF],
                'imprecision'   => [ 5.011, 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 ],
+                        }],
 
                 #'default'     => [ 5.008, DEFAULT_ON ],
        }],
 } ;
 
 
                 #'default'     => [ 5.008, DEFAULT_ON ],
        }],
 } ;
 
+my @def ;
 my %list ;
 my %Value ;
 my %ValueToName ;
 my %list ;
 my %Value ;
 my %ValueToName ;
@@ -151,6 +156,8 @@ sub walk
        my ($ver, $rest) = @{ $v } ;
        if (ref $rest)
          { push (@{ $list{$k} }, walk ($rest)) }
        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} } ;
     }
 
        push @list, @{ $list{$k} } ;
     }
@@ -310,7 +317,8 @@ 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 ;
     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" ;
     $last_ver = $version ;
 }
 print $warn "\n" ;
@@ -416,6 +424,8 @@ foreach $k (sort keys  %list) {
 
 print $pm "  );\n\n" ;
 print $pm '$NONE     = "', ('\0' x $warn_size) , "\";\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" ;
 while (<DATA>) {
 print $pm '$LAST_BIT = ' . "$index ;\n" ;
 print $pm '$BYTES    = ' . "$warn_size ;\n" ;
 while (<DATA>) {
@@ -427,7 +437,7 @@ read_only_bottom_close_and_rename($pm);
 __END__
 package warnings;
 
 __END__
 package warnings;
 
-our $VERSION = '1.13';
+our $VERSION = '1.15';
 
 # Verify that we're called correctly so that warnings will work.
 # see also strict.pm.
 
 # Verify that we're called correctly so that warnings will work.
 # see also strict.pm.
@@ -469,7 +479,8 @@ warnings - Perl pragma to control optional warnings
 
 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.
 
 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.
 
 If no import list is supplied, all possible warnings are either enabled
 or disabled.
@@ -635,7 +646,7 @@ sub import
 {
     shift;
 
 {
     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'} ;
 
     if (vec($mask, $Offsets{'all'}, 1)) {
         $mask |= $Bits{'all'} ;
@@ -651,7 +662,7 @@ sub unimport
     shift;
 
     my $catmask ;
     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'} ;
 
     if (vec($mask, $Offsets{'all'}, 1)) {
         $mask |= $Bits{'all'} ;
@@ -730,8 +741,11 @@ sub __chk
         $i = _error_loc(); # see where Carp will allocate the error
     }
 
         $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) {
 
     my @results;
     foreach my $type (FATAL, NORMAL) {
Unnamed repository; edit this file 'description' to name the repository.