X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/41ac5f6f523429f1cf16ffb5b09af82c921712c2..7ae5d31c28bff87535cb83fdb5c83abac5c5e3ad:/regen/warnings.pl

diff --git a/regen/warnings.pl b/regen/warnings.pl
index b3e1c04..e99ff4b 100644
--- a/regen/warnings.pl
+++ b/regen/warnings.pl
@@ -53,11 +53,11 @@ my $tree = {
 			   }],
        	'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],
@@ -66,7 +66,7 @@ my $tree = {
        	'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],
@@ -84,11 +84,16 @@ my $tree = {
        	'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 ],
   	}],
 } ;
 
+my @def ;
 my %list ;
 my %Value ;
 my %ValueToName ;
@@ -151,6 +156,8 @@ sub walk
 	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} } ;
     }
@@ -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 ;
-    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" ;
@@ -416,6 +424,8 @@ foreach $k (sort keys  %list) {
 
 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>) {
@@ -427,7 +437,7 @@ read_only_bottom_close_and_rename($pm);
 __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.
@@ -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.
-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.
@@ -635,7 +646,7 @@ sub import
 {
     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'} ;
@@ -651,7 +662,7 @@ sub unimport
     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'} ;
@@ -730,8 +741,11 @@ sub __chk
         $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) {