Skip to content

Commit

Permalink
warnings.pm - support deprecated::smartmatch category
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
demerphq committed Feb 25, 2023
1 parent ffdab98 commit 2d705ed
Show file tree
Hide file tree
Showing 5 changed files with 39 additions and 23 deletions.
17 changes: 12 additions & 5 deletions lib/warnings.pm

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

6 changes: 3 additions & 3 deletions pod/perldiag.pod
Original file line number Diff line number Diff line change
Expand Up @@ -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>.

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
28 changes: 16 additions & 12 deletions regen/warnings.pl
Original file line number Diff line number Diff line change
Expand Up @@ -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],
Expand Down Expand Up @@ -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) }
}
}

Expand Down Expand Up @@ -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} } ;
}
Expand Down Expand Up @@ -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" }
Expand Down
6 changes: 3 additions & 3 deletions toke.c
Original file line number Diff line number Diff line change
Expand Up @@ -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);
}
Expand Down Expand Up @@ -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);

Expand Down Expand Up @@ -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);

Expand Down
5 changes: 5 additions & 0 deletions warnings.h

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 2d705ed

Please sign in to comment.