warnings.pm - support deprecated::smartmatch category

Currently we seem to lack a way to have a subcategory under deprecated.
It seems reasonable to me that people might want to disable a specific
subcategory warning while leaving the rest in place. This patch allows
that. Note that both

    no warnings "deprecated";

and

    no warnings "deprecated::smartmatch";

work to disable the warning. Really this needs tests, but this will shut
up autodie warnings, so we can do the tests for this later. Also we
should go through and enumerate all the deprecated subcategories and
switch to using them. Deprecated warnings shouldn't be "all or nothing".
Again, I think that should happen after this is merged.

Author: demerphq

lib/warnings.pm

@@ -2645,7 +2645,7 @@ L<perlfunc/getsockopt>.
 
 =item given is deprecated
 
-(D deprecated) C<given> depends on smartmatch, which is deprecated. It
+(D deprecated::smartmatch) C<given> depends on smartmatch, which is deprecated. It
 will be removed in Perl 5.42.  See the explanation under
 L<perlsyn/Experimental Details on given and when>.
 
@@ -6039,7 +6039,7 @@ for the smart match.
 
 =item Smartmatch is deprecated
 
-(D deprecated) This warning is emitted if you
+(D deprecated::smartmatch) This warning is emitted if you
 use the smartmatch (C<~~>) operator.  This is a deprecated
 feature.  Particularly, its behavior is noticed for being
 unnecessarily complex and unintuitive, and it will be removed
@@ -8025,7 +8025,7 @@ So put in parentheses to say what you really mean.
 
 =item when is deprecated
 
-(D deprecated) C<when> depends on smartmatch, which is
+(D deprecated::smartmatch) C<when> depends on smartmatch, which is
 deprecated.  Additionally, it has several special cases that may
 not be immediately obvious, and it will be removed in Perl 5.42.
 See the explanation

pod/perldiag.pod

@@ -74,7 +74,9 @@ BEGIN
                                 'debugging'     => [ 5.008, DEFAULT_ON],
                                 'malloc'        => [ 5.008, DEFAULT_ON],
                            }],
-        'deprecated'    => [ 5.008, DEFAULT_ON],
+        'deprecated'    => [ 5.008, DEFAULT_ON, {
+                                'deprecated::smartmatch' => [ 5.037009, DEFAULT_ON],
+                        }],
         'void'          => [ 5.008, DEFAULT_OFF],
         'recursion'     => [ 5.008, DEFAULT_OFF],
         'redefine'      => [ 5.008, DEFAULT_OFF],
@@ -204,12 +206,12 @@ sub valueWalk
         die "Value associated with key '$k' is not an ARRAY reference"
             if !ref $v || ref $v ne 'ARRAY' ;
 
-        my ($ver, $rest) = @{ $v } ;
+        my ($ver, $rest, $rest2) = @{ $v } ;
+        my $ref = ref $rest ? $rest : $rest2;
         push @{ $v_list->{$ver} }, $k;
 
-        if (ref $rest)
-          { valueWalk ($rest, $v_list) }
-
+        if (ref $ref)
+          { valueWalk ($ref, $v_list) }
     }
 }
 
@@ -265,11 +267,12 @@ sub walk
         die "Value associated with key '$k' is not an ARRAY reference"
             if !ref $v || ref $v ne 'ARRAY' ;
 
-        my ($ver, $rest) = @{ $v } ;
-        if (ref $rest)
-          { push (@{ $CATEGORIES{$k} }, walk ($rest)) }
-        elsif ($rest == DEFAULT_ON)
+        my ($ver, $rest, $rest2) = @{ $v } ;
+        my $ref = ref $rest ? $rest : $rest2;
+        if (!ref $rest and $rest == DEFAULT_ON)
           { push @DEFAULTS, $NAME_TO_VALUE{uc $k} }
+        if (ref $ref)
+          { push (@{ $CATEGORIES{$k} }, walk ($ref)) }
 
         push @list, @{ $CATEGORIES{$k} } ;
     }
@@ -334,12 +337,13 @@ sub warningsTree
             $offset = ' ' x ($max + 1) ;
         }
 
-        my ($ver, $rest) = @{ $v } ;
-        if (ref $rest)
+        my ($ver, $rest, $rest2) = @{ $v } ;
+        my $ref = ref $rest ? $rest : $rest2;
+        if (ref $ref)
         {
             my $bar = @keys ? "|" : " ";
             $rv .= " -" . "-" x ($max - length $k ) . "+\n" ;
-            $rv .= warningsTree ($rest, $prefix . $bar . $offset )
+            $rv .= warningsTree ($ref, $prefix . $bar . $offset )
         }
         else
           { $rv .= "\n" }

regen/warnings.pl

@@ -6638,7 +6638,7 @@ yyl_tilde(pTHX_ char *s)
             TOKEN(0);
         s += 2;
         Perl_ck_warner_d(aTHX_
-            packWARN(WARN_DEPRECATED),
+            packWARN(WARN_DEPRECATED__SMARTMATCH),
             "Smartmatch is deprecated");
         NCEop(OP_SMARTMATCH);
     }
@@ -8179,7 +8179,7 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct
 
     case KEY_given:
         pl_yylval.ival = CopLINE(PL_curcop);
-        Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
+        Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED__SMARTMATCH),
                          "given is deprecated");
         OPERATOR(KW_GIVEN);
 
@@ -8702,7 +8702,7 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct
             return REPORT(0);
         pl_yylval.ival = CopLINE(PL_curcop);
         Perl_ck_warner_d(aTHX_
-            packWARN(WARN_DEPRECATED),
+            packWARN(WARN_DEPRECATED__SMARTMATCH),
             "when is deprecated");
         OPERATOR(KW_WHEN);