From de624d7d506c00d82c9ea812d0114962cc1f6703 Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Mon, 4 Dec 2023 19:56:25 -0800 Subject: [PATCH] add -wvuxl --- dev-bin/perltidy_random_setup.pl | 2 + lib/Perl/Tidy.pm | 31 ++++++------ lib/Perl/Tidy/Formatter.pm | 83 ++++++++++++++++++++++++-------- 3 files changed, 80 insertions(+), 36 deletions(-) diff --git a/dev-bin/perltidy_random_setup.pl b/dev-bin/perltidy_random_setup.pl index 7a0f8147..04083d44 100755 --- a/dev-bin/perltidy_random_setup.pl +++ b/dev-bin/perltidy_random_setup.pl @@ -1169,6 +1169,8 @@ EOM 'output-line-ending' => [ 'dos', 'win', 'mac', 'unix' ], 'extended-block-tightness-list' => [ 'k', 't', 'kt' ], + 'warn-variable-usage' => ['0', '1'], + 'space-backslash-quote' => [ 0, 2 ], 'block-brace-tightness' => [ 0, 2 ], 'keyword-paren-inner-tightness' => [ 0, 2 ], diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index cf5df0fb..d224b10b 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -3633,21 +3633,22 @@ sub generate_options { ######################################## $category = 9; # Other controls ######################################## - $add_option->( 'warn-missing-else', 'wme', '!' ); - $add_option->( 'add-missing-else', 'ame', '!' ); - $add_option->( 'add-missing-else-comment', 'amec', '=s' ); - $add_option->( 'delete-block-comments', 'dbc', '!' ); - $add_option->( 'delete-closing-side-comments', 'dcsc', '!' ); - $add_option->( 'delete-pod', 'dp', '!' ); - $add_option->( 'delete-side-comments', 'dsc', '!' ); - $add_option->( 'tee-block-comments', 'tbc', '!' ); - $add_option->( 'tee-pod', 'tp', '!' ); - $add_option->( 'tee-side-comments', 'tsc', '!' ); - $add_option->( 'look-for-autoloader', 'lal', '!' ); - $add_option->( 'look-for-hash-bang', 'x', '!' ); - $add_option->( 'look-for-selfloader', 'lsl', '!' ); - $add_option->( 'pass-version-line', 'pvl', '!' ); - $add_option->( 'warn-variable-usage', 'wvu', '=s' ); + $add_option->( 'warn-missing-else', 'wme', '!' ); + $add_option->( 'add-missing-else', 'ame', '!' ); + $add_option->( 'add-missing-else-comment', 'amec', '=s' ); + $add_option->( 'delete-block-comments', 'dbc', '!' ); + $add_option->( 'delete-closing-side-comments', 'dcsc', '!' ); + $add_option->( 'delete-pod', 'dp', '!' ); + $add_option->( 'delete-side-comments', 'dsc', '!' ); + $add_option->( 'tee-block-comments', 'tbc', '!' ); + $add_option->( 'tee-pod', 'tp', '!' ); + $add_option->( 'tee-side-comments', 'tsc', '!' ); + $add_option->( 'look-for-autoloader', 'lal', '!' ); + $add_option->( 'look-for-hash-bang', 'x', '!' ); + $add_option->( 'look-for-selfloader', 'lsl', '!' ); + $add_option->( 'pass-version-line', 'pvl', '!' ); + $add_option->( 'warn-variable-usage', 'wvu', '=s' ); + $add_option->( 'warn-variable-usage-exclusion-list', 'wvuxl', '=s' ); ######################################## $category = 13; # Debugging diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index 39bc99de..57c4e828 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -8657,7 +8657,6 @@ sub warn_variable_usage { my $ris_sub_block = $self->[_ris_sub_block_]; my $K_closing_container = $self->[_K_closing_container_]; my $rK_next_seqno_by_K = $self->[_rK_next_seqno_by_K_]; - my $rtype_count_by_seqno = $self->[_rtype_count_by_seqno_]; my %is_re_match_op = ( '=~' => 1, '!~' => 1 ); my %is_my_state = ( 'my' => 1, 'state' => 1 ); @@ -8685,10 +8684,10 @@ sub warn_variable_usage { my $wvu_key = 'warn-variable-usage'; my $wvu_option = $rOpts->{$wvu_key}; - my $check_unused = $wvu_option =~ /[u1\*]/; - my $check_reused = $wvu_option =~ /[r1\*]/; my $check_sigil = $wvu_option =~ /[s1\*]/; my $check_cross_package = $wvu_option =~ /[p1\*]/; + my $check_unused = $wvu_option =~ /[u1\*]/; + my $check_reused = $wvu_option =~ /[r1\*]/; # The block stack: # [$seqno, $rhash ] @@ -8721,6 +8720,21 @@ sub warn_variable_usage { my %package_warnings; # warning messages for package cross-over my %sub_count_by_package; # how many subs defined in a package + # Default names which are excluded from test types 'u' and 'r': + my @xl = qw($self $class); + + my $wvuxl_key = 'warn-variable-usage-exclusion-list'; + my $excluded_names = $rOpts->{$wvuxl_key}; + if ($excluded_names) { + $excluded_names =~ s/,/ /; + $excluded_names =~ s/^\s+//; + $excluded_names =~ s/\s+$//; + @xl = split /\s+/, $excluded_names; + } + + my %is_excluded_name; + @{is_excluded_name}{@xl} = (1) x scalar(@xl); + # Variables for scanning interpolated quotes: my $ix_HERE_END = -1; # the line index of the last here target read my $in_interpolated_quote; # in multiline quote with interpolation? @@ -8743,11 +8757,24 @@ sub warn_variable_usage { $word = $2; } + my $skip_reused_test = $is_excluded_name{$name}; + my @sigils_to_test; - if ($check_sigil) { @sigils_to_test = qw($ @ %) } - elsif ($check_reused) { @sigils_to_test = ($sigil) } + if ($check_sigil) { + if ( $check_reused && !$skip_reused_test ) { + @sigils_to_test = (qw($ @ %)); + } + else { + foreach my $sig (qw($ @ %)) { + if ( $sig ne $sigil ) { push @sigils_to_test, $sig; } + } + } + } + elsif ( $check_reused && !$skip_reused_test ) { + push @sigils_to_test, $sigil; + } else { - # skip tests + # neither } # Look up the stack to see if this name has been seen, possibly @@ -8760,14 +8787,17 @@ sub warn_variable_usage { next unless ( $rhash->{$test_name} ); my $first_line = $rhash->{$test_name}->[1] + 1; my $msg; + my $letter; if ( $sig eq $sigil ) { $msg = "$my_keyword $name reused, see line $first_line"; + $letter = 'r'; } else { $msg = -"$my_keyword $name is like $test_name with a sigil change, see line $first_line"; +"$my_keyword $name and $test_name overlap in scope, see line $first_line"; + $letter = 's'; } - push @warnings, [ $msg, $line_index + 1 ]; + push @warnings, [ $msg, $line_index + 1, $letter ]; last; } } @@ -8959,8 +8989,8 @@ sub warn_variable_usage { # pop stack and scan results at a closing block brace elsif ($block_type) { - my ( $prev_seqno, $rmy_var_hash ) = - @{ $rblock_stack->[-1] }; + my $stack_item = pop @{$rblock_stack}; + my ( $prev_seqno, $rmy_var_hash ) = @{$stack_item}; # check for stack error if ( $prev_seqno ne $seqno ) { @@ -8980,16 +9010,18 @@ sub warn_variable_usage { my $item = $rmy_var_hash->{$name}; my ( $count, $line_index, $lex_type, $pkg ) = @{$item}; - if ( !$count ) { + if ( !$count + && !$is_excluded_name{$name} ) + { push @warnings, [ "$lex_type $name unused", - $line_index + 1 + $line_index + 1, + 'u' ]; } } } - pop @{$rblock_stack}; } else { # not a block @@ -9135,7 +9167,7 @@ sub warn_variable_usage { $package_warnings{$package} = $rpackage_warnings; } foreach my $item ( @{$rblock_stack} ) { - my ( $seqno, $rhash ) = @{$item}; + my ( $seqno_item, $rhash ) = @{$item}; foreach my $name ( keys %{$rhash} ) { my $entry = $rhash->{$name}; my ( $count, $line_index, $lex_type, $pkg ) = @@ -9144,7 +9176,8 @@ sub warn_variable_usage { push @{$rpackage_warnings}, [ "$lex_type $name is accessible in later packages", - $line_index + 1 + $line_index + 1, + 'p' ]; } } @@ -9202,15 +9235,20 @@ sub warn_variable_usage { } else { - # does it follow =~ or !~ + # is interpolated if it follow a match operator =~ or !~ if ( $K_last_code && $is_re_match_op{ $rLL->[$K_last_code]->[_TYPE_] } ) { $interpolated = 1; } - # does it NOT have a leading operator: qw q y tr ' - elsif ( $token !~ /^(qw|q[^qrx]|y|tr|\')/ ) { + # is not interpolated for leading operators: qw q y tr ' + elsif ( $token =~ /^(qw|q[^qrx]|y|tr|\')/ ) { + $interpolated = 0; + } + + # is interpolated for everything else + else { $interpolated = 1; } } @@ -9249,7 +9287,7 @@ sub warn_variable_usage { if ($check_unused) { if ( !$count ) { push @warnings, - [ "$lex_type $name unused", $line_index + 1 ]; + [ "$lex_type $name unused", $line_index + 1, 'u' ]; } } } @@ -9275,9 +9313,12 @@ sub warn_variable_usage { # warning message to avoid the warning line limit. if (@warnings) { my $message = "Begin scan for --$wvu_key=$wvu_option:\n"; + $message .= <[1] <=> $b->[1] } @warnings ) { - my ( $msg, $lno ) = @{$item}; - $message .= "$lno: $msg\n"; + my ( $msg, $lno, $letter ) = @{$item}; + $message .= "$lno:$letter: $msg\n"; } $message .= "End scan for --$wvu_key=$wvu_option:\n"; warning($message); -- 2.39.5