From cd66136805f486651dc98b5e64650b55f8bfe45a Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Tue, 25 Jun 2024 08:10:10 -0700 Subject: [PATCH] updates for git #151 --- bin/perltidy | 21 +++--- lib/Perl/Tidy.pm | 5 +- lib/Perl/Tidy/Formatter.pm | 139 +++++++++++++++++++++++++++++++------ 3 files changed, 133 insertions(+), 32 deletions(-) diff --git a/bin/perltidy b/bin/perltidy index c57a461b..1756a25d 100755 --- a/bin/perltidy +++ b/bin/perltidy @@ -6016,19 +6016,22 @@ types of variables to be checked. For example: will process F normally but issue a warning if either of the issues 's' or 'r', but not 'p', described above, are encountered. -A limitation is that warnings may not be requested for unused variables, type -'u'. The is because this would produce many needless warnings, especially when -perltidy is run on small snippets of code from within an editor. So -unused variables can only be found with the B<-duv> option described in the -previous section. +The 'u' option (unused) has a limitation: it is not allowed in a F<.perltidyrc> +configuration file. But it can be used on the command line provided that +perltidy is operating on a named file. This rule is necessary to avoid +warnings when perltidy is run on small snippets of code from within an editor. A companion flag, B<--warn-variable-exclusion-list=string>, or B<-wvxl=string>, -can be used to skip warning checks for a list of variables. For example, +can be used to skip warning checks for a list of variable names. A leading +and/or trailing '*' may be placed on any of these variable names to allow a +partial match. For example - perltidy -wvt='*' -wvxl='$self $class' somefile.pl +For example, + + perltidy -wvt='*' -wvxl='$self $class *_unused' somefile.pl -will do all possible checks but not report any warnings for variables C<$self> -and C<$class>. +will do all possible checks but not report any warnings for variables C<$self>, +C<$class>, and for example C<$value_unused>. =item B diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index 36a08054..c7b24bca 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -839,6 +839,9 @@ EOM @ARGV_saved = ( $ARGV[-2], $ARGV[-1] ); } + # see if -wvt was entered on the command line before @ARGV is changed + my $wvt_in_args = grep { /-(wvt|warn-variable-types)=/ } @ARGV; + #------------------------- # get command line options #------------------------- @@ -974,7 +977,7 @@ EOM my ( $in_place_modify, $backup_extension, $delete_backup ) = $self->check_in_place_modify( $source_stream, $destination_stream ); - Perl::Tidy::Formatter::check_options($rOpts); + Perl::Tidy::Formatter::check_options( $rOpts, $wvt_in_args, $num_files ); Perl::Tidy::Tokenizer::check_options($rOpts); Perl::Tidy::VerticalAligner::check_options($rOpts); if ( $rOpts->{'format'} eq 'html' ) { diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index 15345c2e..6b054b75 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -1459,7 +1459,7 @@ sub check_options { # This routine is called to check the user-supplied run parameters # and to configure the control hashes to them. - $rOpts = shift; + ( $rOpts, my $wvt_in_args, my $num_files ) = @_; initialize_whitespace_hashes(); @@ -1496,7 +1496,7 @@ sub check_options { initialize_call_paren_style(); - initialize_warn_variable_types(); + initialize_warn_variable_types( $wvt_in_args, $num_files ); initialize_warn_mismatched_args(); @@ -8679,6 +8679,12 @@ sub scan_variable_usage { $roption = { 'r' => 1, 's' => 1, 'p' => 1, 'u' => 1 }; } + my $issue_type_string = "Issue types are"; + if ( $roption->{'u'} ) { $issue_type_string .= " 'u'=unused" } + if ( $roption->{'r'} ) { $issue_type_string .= " 'r'=reused" } + if ( $roption->{'s'} ) { $issue_type_string .= " 's'=multi-sigil" } + if ( $roption->{'p'} ) { $issue_type_string .= " 'p'=package crossing" } + # Unpack the control hash my $check_sigil = $roption->{'s'}; my $check_cross_package = $roption->{'p'}; @@ -9466,7 +9472,7 @@ EOM my @sorted = sort { $a->{K} <=> $b->{K} || $a->{letter} cmp $b->{letter} } @warnings; - return \@sorted; + return ( \@sorted, $issue_type_string ); } ## end sub scan_variable_usage sub dump_unusual_variables { @@ -9474,12 +9480,15 @@ sub dump_unusual_variables { # process a --dump-unusual-variables(-duv) command - my $rlines = $self->scan_variable_usage(); + my ( $rlines, $issue_type_string ) = $self->scan_variable_usage(); return unless ( $rlines && @{$rlines} ); + my $input_stream_name = get_input_stream_name(); + # output for multiple types my $output_string = <{$wv_key}; return unless (%warn_variable_types); - my $rwarnings = $self->scan_variable_usage( \%warn_variable_types ); + my ( $rwarnings, $issue_type_string ) = + $self->scan_variable_usage( \%warn_variable_types ); return unless ( $rwarnings && @{$rwarnings} ); - my $message = "Begin scan for --$wv_key=$wv_option\n"; - $message .= < 1 ) { + push @wildcard_prefixes, [ $key, $val ]; + } + } - # output the results, ignoring any excluded names + my $is_excluded = sub { + + my $name = shift; + + # check for direct match + if ( $is_warn_variable_excluded_name{$name} ) { return 1 } + + # look for wildcard match + foreach (@wildcard_prefixes) { + my ( $key, $code ) = @{$_}; + my $len_key = length($key); + my $len_name = length($name); + next if ( $len_name < $len_key ); + + # code 2 = left star only + if ( $code == 2 ) { + if ( substr( $name, -$len_key, $len_key ) eq $key ) { return 1 } + } + + # code 3 = right star only + elsif ( $code == 3 ) { + if ( substr( $name, 0, $len_key ) eq $key ) { return 1 } + } + + # code 4 = both left and right stars + elsif ( $code == 4 ) { + if ( index( $name, $key, 0 ) >= 0 ) { return 1 } + } + else { + DEVEL_MODE && Fault("unexpected code '$code' for '$name'\n"); + } + } + return; + }; + + # loop to form error messages + my $message_middle = EMPTY_STRING; foreach my $item ( @{$rwarnings} ) { my $name = $item->{name}; - next if ( $is_warn_variable_excluded_name{$name} ); + + # ignore excluded names + next if ( $is_excluded->($name) ); + my $lno = $item->{line_number}; my $letter = $item->{letter}; my $keyword = $item->{keyword}; my $note = $item->{note}; if ($note) { $note = ": $note" } - $message .= "$lno:$letter: $keyword $name$note\n"; + $message_middle .= "$lno:$letter: $keyword $name$note\n"; + } + + if ($message_middle) { + my $message = "Begin scan for --$wv_key=$wv_option\n"; + $message .= <