From 5d0fbb18c2d337e8432f55883ebe98a7ac48af41 Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Mon, 19 Aug 2024 13:30:58 -0700 Subject: [PATCH] mark unused vars with _uu This is short for _unused and helps keep line length down. This update allows perltidy to check for unused variables whenever it is run. --- bin/perltidy | 1 - lib/Perl/Tidy.pm | 14 +-- lib/Perl/Tidy/Debugger.pm | 14 +-- lib/Perl/Tidy/FileWriter.pm | 6 +- lib/Perl/Tidy/Formatter.pm | 145 ++++++++++++++++--------------- lib/Perl/Tidy/HtmlWriter.pm | 12 +-- lib/Perl/Tidy/Tokenizer.pm | 75 ++++++++-------- lib/Perl/Tidy/VerticalAligner.pm | 75 ++++++++-------- perltidyrc | 3 +- 9 files changed, 174 insertions(+), 171 deletions(-) diff --git a/bin/perltidy b/bin/perltidy index 8d6853c1..835a0f53 100755 --- a/bin/perltidy +++ b/bin/perltidy @@ -1,6 +1,5 @@ #!/usr/bin/perl package main; - use Perl::Tidy; my $arg_string = undef; diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index adbbdf9a..d9623e05 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -736,9 +736,9 @@ EOM # except if there has been a bug introduced by a recent program change. # Please add comments at calls to Fault to explain why the call # should not occur, and where to look to fix it. - my ( $package0, $filename0, $line0, $subroutine0 ) = caller(0); - my ( $package1, $filename1, $line1, $subroutine1 ) = caller(1); - my ( $package2, $filename2, $line2, $subroutine2 ) = caller(2); + my ( $package0_uu, $filename0_uu, $line0, $subroutine0_uu ) = caller(0); + my ( $package1_uu, $filename1, $line1, $subroutine1 ) = caller(1); + my ( $package2_uu, $filename2_uu, $line2_uu, $subroutine2 ) = caller(2); my $pkg = __PACKAGE__; my $input_stream_name = $rstatus->{'input_name'}; @@ -2159,7 +2159,7 @@ sub process_all_files { # add option to change path here if ( defined( $rOpts->{'output-path'} ) ) { - my ( $base, $old_path ) = fileparse($fileroot); + my ( $base, $old_path_uu ) = fileparse($fileroot); my $new_path = $rOpts->{'output-path'}; if ( !-d $new_path ) { mkdir($new_path) # Default MODE is 0777 @@ -4414,8 +4414,8 @@ sub process_command_line { my @q = @_; my ( - $perltidyrc_stream, $is_Windows, $Windows_type, - $rpending_complaint, $dump_options_type + $perltidyrc_stream, $is_Windows_uu, $Windows_type_uu, + $rpending_complaint_uu, $dump_options_type ) = @q; my $use_cache = !defined($perltidyrc_stream) && !$dump_options_type; @@ -5534,7 +5534,7 @@ sub find_config_file { if ($is_Windows) { if ($Windows_type) { - my ( $os, $system, $allusers ) = + my ( $os_uu, $system, $allusers ) = Win_Config_Locs( $rpending_complaint, $Windows_type ); # Check All Users directory, if there is one. diff --git a/lib/Perl/Tidy/Debugger.pm b/lib/Perl/Tidy/Debugger.pm index 03d4a938..2fb8f5db 100644 --- a/lib/Perl/Tidy/Debugger.pm +++ b/lib/Perl/Tidy/Debugger.pm @@ -67,14 +67,14 @@ sub write_debug_entry { # to the .DEBUG file when the -D flag is entered. my ( $self, $line_of_tokens ) = @_; - my $input_line = $line_of_tokens->{_line_text}; - - my $rtoken_type = $line_of_tokens->{_rtoken_type}; - my $rtokens = $line_of_tokens->{_rtokens}; - my $rlevels = $line_of_tokens->{_rlevels}; - + my $rtoken_type = $line_of_tokens->{_rtoken_type}; + my $rtokens = $line_of_tokens->{_rtokens}; my $input_line_number = $line_of_tokens->{_line_number}; - my $line_type = $line_of_tokens->{_line_type}; + +## uncomment if needed: +## my $input_line = $line_of_tokens->{_line_text}; +## my $rlevels = $line_of_tokens->{_rlevels}; +## my $line_type = $line_of_tokens->{_line_type}; my $token_str = "$input_line_number: "; my $reconstructed_original = "$input_line_number: "; diff --git a/lib/Perl/Tidy/FileWriter.pm b/lib/Perl/Tidy/FileWriter.pm index d8c2578e..2168c1e8 100644 --- a/lib/Perl/Tidy/FileWriter.pm +++ b/lib/Perl/Tidy/FileWriter.pm @@ -97,9 +97,9 @@ sub Fault { # except if there has been a bug introduced by a recent program change. # Please add comments at calls to Fault to explain why the call # should not occur, and where to look to fix it. - my ( $package0, $filename0, $line0, $subroutine0 ) = caller(0); - my ( $package1, $filename1, $line1, $subroutine1 ) = caller(1); - my ( $package2, $filename2, $line2, $subroutine2 ) = caller(2); + my ( $package0_uu, $filename0_uu, $line0, $subroutine0_uu ) = caller(0); + my ( $package1_uu, $filename1, $line1, $subroutine1 ) = caller(1); + my ( $package2_uu, $filename2_uu, $line2_uu, $subroutine2 ) = caller(2); my $pkg = __PACKAGE__; # Catch potential error of Fault not called as a method diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index 9637abaf..4affb330 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -127,9 +127,9 @@ sub Fault { # except if there has been a bug introduced by a recent program change. # Please add comments at calls to Fault to explain why the call # should not occur, and where to look to fix it. - my ( $package0, $filename0, $line0, $subroutine0 ) = caller(0); - my ( $package1, $filename1, $line1, $subroutine1 ) = caller(1); - my ( $package2, $filename2, $line2, $subroutine2 ) = caller(2); + my ( $package0_uu, $filename0_uu, $line0, $subroutine0_uu ) = caller(0); + my ( $package1_uu, $filename1, $line1, $subroutine1 ) = caller(1); + my ( $package2_uu, $filename2_uu, $line2_uu, $subroutine2 ) = caller(2); my $pkg = __PACKAGE__; my $input_stream_name = get_input_stream_name(); @@ -156,9 +156,9 @@ sub Fault_Warn { # This is the same as Fault except that it calls Warn instead of Die # and returns. - my ( $package0, $filename0, $line0, $subroutine0 ) = caller(0); - my ( $package1, $filename1, $line1, $subroutine1 ) = caller(1); - my ( $package2, $filename2, $line2, $subroutine2 ) = caller(2); + my ( $package0_uu, $filename0_uu, $line0, $subroutine0_uu ) = caller(0); + my ( $package1_uu, $filename1, $line1, $subroutine1 ) = caller(1); + my ( $package2_uu, $filename2_uu, $line2_uu, $subroutine2 ) = caller(2); my $input_stream_name = get_input_stream_name(); Warn(<{_rK_range}; - my ( $Kfirst, $Klast ) = @{$rK_range}; + my ( $Kfirst, $Klast_uu ) = @{$rK_range}; # skip a blank line next if ( !defined($Kfirst) ); @@ -8817,7 +8817,7 @@ sub is_complete_script { my $line_type = $line_of_tokens->{_line_type}; if ( $line_type eq 'CODE' ) { - my ( $Kfirst, $Klast ) = @{ $line_of_tokens->{_rK_range} }; + my ( $Kfirst_uu, $Klast ) = @{ $line_of_tokens->{_rK_range} }; if ($Klast) { my $type = $rLL->[$Klast]->[_TYPE_]; if ( $type eq '#' ) { @@ -9212,6 +9212,7 @@ sub scan_variable_usage { } } } + return; }; ## end $check_for_overlapping_variables = sub #-------------------------------- @@ -9550,7 +9551,7 @@ sub scan_variable_usage { # --$KK --$seqno of brace that we want # if ( $rLL->[$K_n]->[_TOKEN_] eq 'elsif' ) { - ( $seqno_block, my $K_last_iterator ) = + ( $seqno_block, my $K_last_iterator_uu ) = $self->block_seqno_of_paren_keyword($K_n); } @@ -13567,7 +13568,7 @@ sub match_trailing_comma_rule { my $rtype_count_pp = $self->[_rtype_count_by_seqno_]->{$seqno_pp}; return unless ($rtype_count_pp); $comma_count_inner = $rtype_count_pp->{','}; - my $fat_comma_count_inner = $rtype_count_pp->{'=>'}; +## my $fat_comma_count_inner = $rtype_count_pp->{'=>'}; return if ( !$comma_count_inner ); return if ( $comma_count_inner < 2 ); @@ -14710,7 +14711,7 @@ sub count_list_elements { # Set the counts to undef in case we have to do a simple return upon # encountering an indeterminate list count my $shift_count_min_input = $rarg_list->{shift_count_min}; - my $shift_count_max_input = $rarg_list->{shift_count_max}; +## my $shift_count_max_input = $rarg_list->{shift_count_max}; $rarg_list->{shift_count_min} = undef; $rarg_list->{shift_count_max} = undef; @@ -15859,8 +15860,8 @@ sub count_sub_return_args { foreach ( @{$rKlist} ) { my $K_return = $rLL->[$_]->[_TYPE_] eq 'b' ? $_ + 1 : $_; - my $type = $rLL->[$K_return]->[_TYPE_]; - my $token = $rLL->[$K_return]->[_TOKEN_]; +## my $type = $rLL->[$K_return]->[_TYPE_]; + my $token = $rLL->[$K_return]->[_TOKEN_]; if ( $token ne 'return' ) { DEVEL_MODE && Fault("expecting 'return' but got $token\n"); last; @@ -16756,7 +16757,7 @@ sub cross_check_sub_calls { @debug_warnings = sort { $a->{Ko} <=> $b->{Ko} } @debug_warnings; my $output_string = EMPTY_STRING; foreach my $item (@debug_warnings) { - my $caller_name = $item->{caller_name}; +## my $caller_name = $item->{caller_name}; my $parent_self = $item->{parent_self}; my $receiver_self = $item->{receiver_self}; my $sub_called = $item->{sub_called}; @@ -17047,13 +17048,13 @@ sub cross_check_sub_calls { $name = $rsub_item->{name}; $lno = $rsub_item->{line_number}; - my $rK_return_list = $item->{rK_return_list}; - my $rself_calls = $item->{self_calls}; - my $rdirect_calls = $item->{direct_calls}; - my $num_self = defined($rself_calls) ? @{$rself_calls} : 0; - my $num_direct = defined($rdirect_calls) ? @{$rdirect_calls} : 0; +## my $rK_return_list = $item->{rK_return_list}; + my $rself_calls = $item->{self_calls}; + my $rdirect_calls = $item->{direct_calls}; + my $num_self = defined($rself_calls) ? @{$rself_calls} : 0; + my $num_direct = defined($rdirect_calls) ? @{$rdirect_calls} : 0; - my $K_return_count_min = $rsub_item->{K_return_count_min}; +## my $K_return_count_min = $rsub_item->{K_return_count_min}; my $K_return_count_max = $rsub_item->{K_return_count_max}; $shift_count_min = $rsub_item->{shift_count_min}; @@ -18196,7 +18197,7 @@ sub setup_new_weld_measurements { my $iline_oo = $rLL->[$Kouter_opening]->[_LINE_INDEX_]; my $rK_range = $rlines->[$iline_oo]->{_rK_range}; - my ( $Kfirst, $Klast ) = @{$rK_range}; + my ( $Kfirst, $Klast_uu ) = @{$rK_range}; #------------------------------------------------------------------------- # We now define a reference index, '$Kref', from which to start measuring @@ -18246,7 +18247,7 @@ sub setup_new_weld_measurements { if ( $type_prev eq '=>' ) { my $iline_prev = $rLL->[$Kprev]->[_LINE_INDEX_]; my $rK_range_prev = $rlines->[$iline_prev]->{_rK_range}; - my ( $Kfirst_prev, $Klast_prev ) = @{$rK_range_prev}; + my ( $Kfirst_prev, $Klast_prev_uu ) = @{$rK_range_prev}; foreach my $KK ( reverse( $Kfirst_prev .. $Kref - 1 ) ) { next if ( $rLL->[$KK]->[_TYPE_] eq 'b' ); $Kref = $KK; @@ -18602,7 +18603,7 @@ sub weld_nested_containers { foreach my $iline ( $iline_oo + 1 .. $iline_io ) { my $rK_range = $rlines->[$iline]->{_rK_range}; next unless defined($rK_range); - my ( $Kfirst, $Klast ) = @{$rK_range}; + my ( $Kfirst, $Klast_uu ) = @{$rK_range}; next unless defined($Kfirst); if ( $rLL->[$Kfirst]->[_TYPE_] eq '->' ) { $do_not_weld_rule = 7; @@ -19250,7 +19251,7 @@ sub weld_nested_quotes { # Check the length of the last line (fixes case b1039) if ( !$do_not_weld ) { my $rK_range_ic = $rlines->[$iline_ic]->{_rK_range}; - my ( $Kfirst_ic, $Klast_ic ) = @{$rK_range_ic}; + my ( $Kfirst_ic, $Klast_ic_uu ) = @{$rK_range_ic}; my $excess_ic = $self->excess_line_length_for_Krange( $Kfirst_ic, $Kouter_closing ); @@ -19573,7 +19574,7 @@ sub do_non_indenting_braces { my $KK = $K_opening_container->{$seqno}; my $line_of_tokens = $rlines->[$ix]; my $rK_range = $line_of_tokens->{_rK_range}; - my ( $Kfirst, $Klast ) = @{$rK_range}; + my ( $Kfirst_uu, $Klast ) = @{$rK_range}; $rspecial_side_comment_type->{$Klast} = 'NIB'; push @K_stack, [ $KK, 1 ]; my $Kc = $K_closing_container->{$seqno}; @@ -19866,7 +19867,7 @@ sub break_before_list_opening_containers { my $iline = $rLL->[$KK]->[_LINE_INDEX_]; my $rK_range = $rlines->[$iline]->{_rK_range}; - my ( $Kfirst, $Klast ) = @{$rK_range}; + my ( $Kfirst, $Klast_uu ) = @{$rK_range}; next unless ( $KK == $Kfirst ); } @@ -21548,11 +21549,11 @@ sub process_all_lines { # get updated indentation levels my $rK_range = $line_of_tokens->{_rK_range}; - my ( $K_first, $K_last ) = @{$rK_range}; - if ( defined($K_first) ) { - my $level_0 = $self->[_radjusted_levels_]->[$K_first]; + my ( $Kfirst, $Klast_uu ) = @{$rK_range}; + if ( defined($Kfirst) ) { + my $level_0 = $self->[_radjusted_levels_]->[$Kfirst]; my $ci_level_0 = - $self->[_rLL_]->[$K_first]->[_CI_LEVEL_]; + $self->[_rLL_]->[$Kfirst]->[_CI_LEVEL_]; $line_of_tokens->{_level_0} = $level_0; $line_of_tokens->{_ci_level_0} = $ci_level_0; } @@ -21812,8 +21813,8 @@ EOM my $j_e = $subgroup[$k] - 1; # index i is the actual line number of a keyword - my ( $i_b, $tok_b, $count_b ) = @{ $group[$j_b] }; - my ( $i_e, $tok_e, $count_e ) = @{ $group[$j_e] }; + my ( $i_b, $tok_b_uu, $count_b ) = @{ $group[$j_b] }; + my ( $i_e_uu, $tok_e_uu, $count_e ) = @{ $group[$j_e] }; my $num = $count_e - $count_b + 1; # This subgroup runs from line $ib to line $ie-1, but may contain @@ -21825,18 +21826,18 @@ EOM my $nog_b = my $nog_e = 1; if ( @iblanks && !$rOpts_kgb_delete ) { my $j_bb = $j_b + $num - 1; - my ( $i_bb, $tok_bb, $count_bb ) = @{ $group[$j_bb] }; + my ( $i_bb_uu, $tok_bb_uu, $count_bb ) = @{ $group[$j_bb] }; $nog_b = $count_bb - $count_b + 1 == $num; my $j_ee = $j_e - ( $num - 1 ); - my ( $i_ee, $tok_ee, $count_ee ) = @{ $group[$j_ee] }; + my ( $i_ee_uu, $tok_ee_uu, $count_ee ) = @{ $group[$j_ee] }; $nog_e = $count_e - $count_ee + 1 == $num; } if ( $nog_b && $k > $kbeg ) { kgb_insert_blank_after( $i_b - 1 ); } if ( $nog_e && $k < $kend ) { - my ( $i_ep, $tok_ep, $count_ep ) = + my ( $i_ep, $tok_ep_uu, $count_ep_uu ) = @{ $group[ $j_e + 1 ] }; kgb_insert_blank_after( $i_ep - 1 ); } @@ -22653,9 +22654,9 @@ EOM } DEBUG_STORE && do { - my ( $a, $b, $c ) = caller(); + my ( $pkg, $file_uu, $lno ) = caller(); print {*STDOUT} -"STORE: from $a $c: storing token $token type $type lev=$level at $max_index_to_go\n"; +"STORE: from $pkg $lno: storing token $token type $type lev=$level at $max_index_to_go\n"; }; return; } ## end sub store_token_to_go @@ -24493,9 +24494,9 @@ sub compare_indentation_levels { } DEBUG_FORCE && do { - my ( $a, $b, $c ) = caller(); + my ( $pkg, $file_uu, $lno ) = caller(); my $msg = -"FORCE $forced_breakpoint_count after call from $a $c with i=$i max=$max_index_to_go"; +"FORCE $forced_breakpoint_count after call from $pkg $lno with i=$i max=$max_index_to_go"; if ( !defined($i_nonblank) ) { $i = EMPTY_STRING unless defined($i); $msg .= " but could not set break after i='$i'\n"; @@ -24608,11 +24609,11 @@ EOM if ( $i_start < 0 ) { $i_start = 0; - my ( $a, $b, $c ) = caller(); + my ( $pkg, $file_uu, $lno ) = caller(); # Bad call, can only be due to a recent programming change. Fault( -"Program Bug: undo_forced_breakpoint_stack from $a $c has bad i=$i_start " +"Program Bug: undo_forced_breakpoint_stack from $pkg $lno has bad i=$i_start " ) if (DEVEL_MODE); return; } @@ -24625,18 +24626,18 @@ EOM $forced_breakpoint_count--; DEBUG_UNDOBP && do { - my ( $a, $b, $c ) = caller(); + my ( $pkg, $file_uu, $lno ) = caller(); print {*STDOUT} -"UNDOBP: undo forced_breakpoint i=$i $forced_breakpoint_undo_count from $a $c max=$max_index_to_go\n"; +"UNDOBP: undo forced_breakpoint i=$i $forced_breakpoint_undo_count from $pkg $lno max=$max_index_to_go\n"; }; } # shouldn't happen, but not a critical error else { if (DEVEL_MODE) { - my ( $a, $b, $c ) = caller(); + my ( $pkg, $file_uu, $lno ) = caller(); Fault(<[ $n - 1 ]; my $iend_1 = $ri_end->[ $n - 1 ]; - my $ibeg_2 = $ri_beg->[$n]; +## my $ibeg_2 = $ri_beg->[$n]; my $iend_2 = $ri_end->[$n]; if ($itok) { @@ -28174,7 +28175,7 @@ sub correct_lp_indentation { $actual_pos = $predicted_pos; - my ( $indent, $offset, $is_leading, $exists ) = + my ( $indent, $offset, $is_leading_uu, $exists_uu ) = get_saved_opening_indentation($align_seqno); if ( defined($indent) ) { @@ -28404,7 +28405,7 @@ sub correct_lp_indentation_pass_1 { if ( $available_spaces > 0 ) { my $delete_want = min( $available_spaces, $excess ); - my $deleted_spaces = + my $deleted_spaces_uu = $self->reduce_lp_indentation( $ibeg, $delete_want ); $available_spaces = $self->get_available_spaces_to_go($ibeg); } @@ -31474,9 +31475,9 @@ EOM my $identifier_count = $rhash_A->{_identifier_count_A}; # Derived variables: - my $ritem_lengths = $rhash_A->{_ritem_lengths}; - my $ri_term_begin = $rhash_A->{_ri_term_begin}; - my $ri_term_end = $rhash_A->{_ri_term_end}; +## my $ritem_lengths = $rhash_A->{_ritem_lengths}; +## my $ri_term_begin = $rhash_A->{_ri_term_begin}; +## my $ri_term_end = $rhash_A->{_ri_term_end}; my $ri_term_comma = $rhash_A->{_ri_term_comma}; my $rmax_length = $rhash_A->{_rmax_length}; my $comma_count = $rhash_A->{_comma_count}; @@ -31484,15 +31485,15 @@ EOM my $first_term_length = $rhash_A->{_first_term_length}; my $i_first_comma = $rhash_A->{_i_first_comma}; my $i_last_comma = $rhash_A->{_i_last_comma}; - my $i_true_last_comma = $rhash_A->{_i_true_last_comma}; +## my $i_true_last_comma = $rhash_A->{_i_true_last_comma}; # Variables received from caller - my $i_opening_paren = $rhash_IN->{i_opening_paren}; - my $i_closing_paren = $rhash_IN->{i_closing_paren}; - my $rcomma_index = $rhash_IN->{rcomma_index}; - my $next_nonblank_type = $rhash_IN->{next_nonblank_type}; - my $list_type = $rhash_IN->{list_type}; - my $interrupted = $rhash_IN->{interrupted}; + my $i_opening_paren = $rhash_IN->{i_opening_paren}; +## my $i_closing_paren = $rhash_IN->{i_closing_paren}; + my $rcomma_index = $rhash_IN->{rcomma_index}; + my $next_nonblank_type = $rhash_IN->{next_nonblank_type}; + my $list_type = $rhash_IN->{list_type}; +## my $interrupted = $rhash_IN->{interrupted}; my $rdo_not_break_apart = $rhash_IN->{rdo_not_break_apart}; my $must_break_open = $rhash_IN->{must_break_open}; @@ -31539,13 +31540,13 @@ EOM $item_count = $hash_B->{_item_count_B}; # New variables - my $columns = $hash_B->{_columns}; - my $formatted_columns = $hash_B->{_formatted_columns}; - my $formatted_lines = $hash_B->{_formatted_lines}; - my $max_width = $hash_B->{_max_width}; - my $new_identifier_count = $hash_B->{_new_identifier_count}; - my $number_of_fields = $hash_B->{_number_of_fields}; - my $odd_or_even = $hash_B->{_odd_or_even}; + my $columns = $hash_B->{_columns}; + my $formatted_columns = $hash_B->{_formatted_columns}; + my $formatted_lines = $hash_B->{_formatted_lines}; + my $max_width = $hash_B->{_max_width}; + my $new_identifier_count = $hash_B->{_new_identifier_count}; + my $number_of_fields = $hash_B->{_number_of_fields}; +## my $odd_or_even = $hash_B->{_odd_or_even}; my $packed_columns = $hash_B->{_packed_columns}; my $packed_lines = $hash_B->{_packed_lines}; my $pair_width = $hash_B->{_pair_width}; @@ -32563,9 +32564,9 @@ sub set_nobreaks { if ( $i >= 0 && $i <= $j && $j <= $max_index_to_go ) { 0 && do { - my ( $a, $b, $c ) = caller(); + my ( $pkg, $file_uu, $lno ) = caller(); print {*STDOUT} -"NOBREAK: forced_breakpoint $forced_breakpoint_count from $a $c with i=$i max=$max_index_to_go type=$types_to_go[$i]\n"; +"NOBREAK: forced_breakpoint $forced_breakpoint_count from $pkg $lno with i=$i max=$max_index_to_go type=$types_to_go[$i]\n"; }; @nobreak_to_go[ $i .. $j ] = (1) x ( $j - $i + 1 ); @@ -32574,9 +32575,9 @@ sub set_nobreaks { # shouldn't happen; non-critical error else { if (DEVEL_MODE) { - my ( $a, $b, $c ) = caller(); + my ( $pkg, $file_uu, $lno ) = caller(); Fault(<[$i_debug]->get_ci_level(); my $old_level = $rlp_object_list->[$i]->get_level(); - my $old_ci_level = + my $old_ci_level_uu = $rlp_object_list->[$i]->get_ci_level(); Fault(<{'title'}; if ( !$title ) { - ( $title, my $path ) = fileparse($input_file); + ( $title, my $path_uu ) = fileparse($input_file); } my $toc_item_count = 0; my $in_toc_package = EMPTY_STRING; @@ -1007,13 +1007,13 @@ sub make_frame { # 3. - the frame which contains them # get basenames for relative links - my ( $toc_basename, $toc_path ) = fileparse($toc_filename); - my ( $src_basename, $src_path ) = fileparse($src_filename); + my ( $toc_basename, $toc_path_uu ) = fileparse($toc_filename); + my ( $src_basename, $src_path_uu ) = fileparse($src_filename); # 1. Make the table of contents panel, with appropriate changes # to the anchor names - my $src_frame_name = 'SRC'; - my $first_anchor = write_toc_html( + my $src_frame_name = 'SRC'; + my $first_anchor_uu = write_toc_html( { title => $title, toc_filename => $toc_filename, @@ -1064,7 +1064,7 @@ sub write_toc_html {

$title

EOM - my $first_anchor = + my $first_anchor_uu = change_anchor_names( $rtoc, $src_basename, "$src_frame_name" ); $fh->print( join EMPTY_STRING, @{$rtoc} ); diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm index e1b45fa6..02168ab1 100644 --- a/lib/Perl/Tidy/Tokenizer.pm +++ b/lib/Perl/Tidy/Tokenizer.pm @@ -304,9 +304,9 @@ sub Fault { # except if there has been a bug introduced by a recent program change. # Please add comments at calls to Fault to explain why the call # should not occur, and where to look to fix it. - my ( $package0, $filename0, $line0, $subroutine0 ) = caller(0); - my ( $package1, $filename1, $line1, $subroutine1 ) = caller(1); - my ( $package2, $filename2, $line2, $subroutine2 ) = caller(2); + my ( $package0_uu, $filename0_uu, $line0, $subroutine0_uu ) = caller(0); + my ( $package1_uu, $filename1, $line1, $subroutine1 ) = caller(1); + my ( $package2_uu, $filename2_uu, $line2_uu, $subroutine2 ) = caller(2); my $pkg = __PACKAGE__; # Catch potential error of Fault not called as a method @@ -2216,7 +2216,7 @@ sub prepare_for_a_new_file { my $len_1 = length($tok_1); my $len_2 = length($tok_2); - my $pre_type_0 = 'w'; + ##my $pre_type_0 = 'w'; my $pre_type_1 = 'd'; my $pre_type_2 = 'w'; @@ -2437,7 +2437,7 @@ EOM } # now its safe to report errors - my $severe_error = $tokenizer->report_tokenization_errors(); + my $severe_error_uu = $tokenizer->report_tokenization_errors(); # TODO: Could propagate a severe error up @@ -2702,8 +2702,8 @@ EOM ) { # For possible future use.. - my $subname = $2; - my $package = $1 ? $1 : EMPTY_STRING; + ##my $subname = $2; + ##my $package = $1 ? $1 : EMPTY_STRING; } else { return; @@ -2716,7 +2716,7 @@ EOM my $next_char = EMPTY_STRING; if ( $input_line =~ m/\s*(\S)/gcx ) { $next_char = $1 } if ( !$next_char || $next_char eq '#' ) { - ( $next_char, my $i_next ) = + ( $next_char, my $i_next_uu ) = $self->find_next_nonblank_token( $max_token_index, $rtokens, $max_token_index ); } @@ -2781,8 +2781,8 @@ EOM ) { # For possible future use.. - my $subname = $2; - my $package = $1 ? $1 : EMPTY_STRING; + ##my $subname = $2; + ##my $package = $1 ? $1 : EMPTY_STRING; } else { return; @@ -2792,7 +2792,7 @@ EOM my $next_char = EMPTY_STRING; if ( $input_line =~ m/\s*(\S)/gcx ) { $next_char = $1 } if ( !$next_char || $next_char eq '#' ) { - ( $next_char, my $i_next ) = + ( $next_char, my $i_next_uu ) = $self->find_next_nonblank_token( $max_token_index, $rtokens, $max_token_index ); } @@ -3060,7 +3060,7 @@ EOM # An identifier followed by '->' is not indirect object; # fixes b1175, b1176. Fix c257: Likewise for other tokens like # comma, semicolon, closing brace, and single space. - my ( $next_nonblank_token, $i_next ) = + my ( $next_nonblank_token, $i_next_uu ) = $self->find_next_noncomment_token( $i, $rtokens, $max_token_index ); $type = 'Z' if ( !$Z_test_hash{$next_nonblank_token} ); @@ -3117,7 +3117,7 @@ EOM # if this is an empty list, (), then it is not an # error; for example, we might have a constant pi and # invoke it with pi() or just pi; - my ( $next_nonblank_token, $i_next ) = + my ( $next_nonblank_token, $i_next_uu ) = $self->find_next_nonblank_token( $i, $rtokens, $max_token_index ); @@ -3209,7 +3209,7 @@ EOM my $rvars = $rparen_vars->[$paren_depth]; if ( defined($rvars) ) { $container_type = $rparen_type->[$paren_depth]; - ( my $type_lp, $want_brace ) = @{$rvars}; + ( my $type_lp_uu, $want_brace ) = @{$rvars}; } } @@ -3231,7 +3231,7 @@ EOM my $rvars = $rparen_vars->[$paren_depth]; if ( defined($rvars) ) { - my ( $type_lp, $want_brace ) = @{$rvars}; + my ( $type_lp, $want_brace_uu ) = @{$rvars}; if ( $type_lp && $type_lp eq '{' ) { $type = '}'; } @@ -3456,7 +3456,7 @@ EOM my $rvars = $rparen_vars->[ $paren_depth + 1 ]; if ( defined($rvars) ) { - my ( $type_lp, $want_brace ) = @{$rvars}; + my ( $type_lp_uu, $want_brace ) = @{$rvars}; # OLD: Now verify that this is not a trailing form # FIX for git #124: we have to skip this check because @@ -3944,7 +3944,7 @@ EOM if ( ( $expecting != OPERATOR ) && $is_file_test_operator{$next_tok} ) { - my ( $next_nonblank_token, $i_next ) = + my ( $next_nonblank_token, $i_next_uu ) = $self->find_next_nonblank_token( $i + 1, $rtokens, $max_token_index ); @@ -4402,7 +4402,7 @@ EOM my $self = shift; $self->scan_bare_identifier(); - my ( $next_nonblank_tok2, $i_next2 ) = + my ( $next_nonblank_tok2, $i_next2_uu ) = $self->find_next_nonblank_token( $i, $rtokens, $max_token_index ); if ($next_nonblank_tok2) { @@ -4716,7 +4716,7 @@ EOM && $expecting != OPERATOR && $next_nonblank_token eq ':' ) { - my ( $nn_nonblank_token, $i_nn ) = + my ( $nn_nonblank_token, $i_nn_uu ) = $self->find_next_nonblank_token( $i_next, $rtokens, $max_token_index ); $sub_attribute_ok_here = @@ -5691,7 +5691,7 @@ EOM # done if nothing left to scan on this line last if ( $i > $max_token_index ); - my ( $next_nonblank_token, $i_next ) = + my ( $next_nonblank_token_uu, $i_next ) = find_next_nonblank_token_on_this_line( $i, $rtokens, $max_token_index ); @@ -6852,7 +6852,7 @@ sub decide_if_code_block { # USES GLOBAL VARIABLES: $last_nonblank_token my ( $self, $i, $rtokens, $rtoken_type, $max_token_index ) = @_; - my ( $next_nonblank_token, $i_next ) = + my ( $next_nonblank_token, $i_next_uu ) = $self->find_next_nonblank_token( $i, $rtokens, $max_token_index ); # we are at a '{' where a statement may appear. @@ -7219,7 +7219,7 @@ sub decrease_nesting_depth { # Fix part #2 for git82: use saved type for propagation of type 'Z' # through type L-R braces. Perl seems to allow ${bareword} # as an indirect object, but nothing much more complex than that. - ( $statement_type, my $saved_type, my $saved_token ) = + ( $statement_type, my $saved_type, my $saved_token_uu ) = @{ $rnested_statement_type->[$aa][ $rcurrent_depth->[$aa] ] }; if ( $aa == BRACE && $saved_type eq 'Z' @@ -7370,7 +7370,7 @@ sub peek_ahead_for_nonblank_token { next if ( $line =~ /^#/ ); # skip comment # Updated from 2 to 3 to get trigraphs, added for case b1175 - my ( $rtok, $rmap, $rtype ) = pre_tokenize( $line, 3 ); + my ( $rtok, $rmap_uu, $rtype_uu ) = pre_tokenize( $line, 3 ); my $j = $max_token_index + 1; foreach my $tok ( @{$rtok} ) { @@ -7397,8 +7397,8 @@ sub guess_if_pattern_or_conditional { # msg = a warning or diagnostic message # USES GLOBAL VARIABLES: $last_nonblank_token - my ( $self, $i, $rtokens, $rtoken_type, $rtoken_map, $max_token_index ) = - @_; + my ( $self, $i, $rtokens, $rtoken_type, $rtoken_map_uu, $max_token_index ) + = @_; my $is_pattern = 0; my $msg = "guessing that ? after $last_nonblank_token starts a "; @@ -7408,7 +7408,7 @@ sub guess_if_pattern_or_conditional { else { my $ibeg = $i; $i = $ibeg + 1; - my $next_token = $rtokens->[$i]; # first token after ? + ##my $next_token = $rtokens->[$i]; # first token after ? # look for a possible ending ? on this line.. my $in_quote = 1; @@ -7503,8 +7503,8 @@ sub guess_if_pattern_or_division { # $is_pattern = 0 if probably division, =1 if probably a pattern # msg = a warning or diagnostic message # USES GLOBAL VARIABLES: $last_nonblank_token - my ( $self, $i, $rtokens, $rtoken_type, $rtoken_map, $max_token_index ) = - @_; + my ( $self, $i, $rtokens, $rtoken_type, $rtoken_map_uu, $max_token_index ) + = @_; my $is_pattern = 0; my $msg = "guessing that / after $last_nonblank_token starts a "; my $ibeg = $i; @@ -7746,7 +7746,6 @@ sub scan_bare_identifier_do { ) = @_; - my $i_begin = $i; my $package = undef; my $i_beg = $i; @@ -8191,7 +8190,7 @@ sub do_scan_package { # package NAMESPACE VERSION # package NAMESPACE BLOCK # package NAMESPACE VERSION BLOCK - my ( $next_nonblank_token, $i_next ) = + my ( $next_nonblank_token, $i_next_uu ) = $self->find_next_nonblank_token( $i, $rtokens, $max_token_index ); # check that something recognizable follows, but do not parse. @@ -9375,14 +9374,14 @@ EOM } # check for multiple definitions of a sub - ( $next_nonblank_token, my $i_next ) = + ( $next_nonblank_token, my $i_next_uu ) = find_next_nonblank_token_on_this_line( $i, $rtokens, $max_token_index ); } if ( $next_nonblank_token =~ /^(\s*|#)$/ ) { # skip blank or side comment - my ( $rpre_tokens, $rpre_types ) = + my ( $rpre_tokens, $rpre_types_uu ) = $self->peek_ahead_for_n_nonblank_pre_tokens(1); if ( defined($rpre_tokens) && @{$rpre_tokens} ) { $next_nonblank_token = $rpre_tokens->[0]; @@ -9663,7 +9662,7 @@ sub is_possible_numerator { $i++; } - my ( $next_nonblank_token, $i_next ) = + my ( $next_nonblank_token, $i_next_uu ) = $self->find_next_nonblank_token( $i, $rtokens, $max_token_index ); if ( $pattern_test{$next_nonblank_token} ) { @@ -9944,9 +9943,9 @@ sub scan_number_do { @_; my $pos_beg = $rtoken_map->[$i]; my $pos; - my $i_begin = $i; - my $number = undef; - my $type = $input_type; + ##my $i_begin = $i; + my $number = undef; + my $type = $input_type; my $first_char = substr( $input_line, $pos_beg, 1 ); @@ -10107,7 +10106,7 @@ sub find_here_doc { $i, $rtokens, $rtoken_type, - $rtoken_map, + $rtoken_map_uu, $max_token_index ) = @_; @@ -10250,7 +10249,7 @@ sub do_quote { $quoted_string_2, $rtokens, $rtoken_type, - $rtoken_map, + $rtoken_map_uu, $max_token_index, ) = @_; diff --git a/lib/Perl/Tidy/VerticalAligner.pm b/lib/Perl/Tidy/VerticalAligner.pm index 7a5f7fdd..7d070773 100644 --- a/lib/Perl/Tidy/VerticalAligner.pm +++ b/lib/Perl/Tidy/VerticalAligner.pm @@ -106,9 +106,9 @@ sub Fault { # except if there has been a bug introduced by a recent program change. # Please add comments at calls to Fault to explain why the call # should not occur, and where to look to fix it. - my ( $package0, $filename0, $line0, $subroutine0 ) = caller(0); - my ( $package1, $filename1, $line1, $subroutine1 ) = caller(1); - my ( $package2, $filename2, $line2, $subroutine2 ) = caller(2); + my ( $package0_uu, $filename0_uu, $line0, $subroutine0_uu ) = caller(0); + my ( $package1_uu, $filename1, $line1, $subroutine1 ) = caller(1); + my ( $package2_uu, $filename2_uu, $line2_uu, $subroutine2 ) = caller(2); my $pkg = __PACKAGE__; my $input_stream_name = get_input_stream_name(); @@ -1162,7 +1162,8 @@ sub fix_terminal_ternary { my $pad_length = 0; foreach my $j ( 0 .. $maximum_field_index - 1 ) { my $tok = $rtokens_old->[$j]; - my ( $raw_tok, $lev, $tag, $tok_count ) = decode_alignment_token($tok); + my ( $raw_tok, $lev, $tag_uu, $tok_count_uu ) = + decode_alignment_token($tok); if ( $raw_tok eq '?' ) { $depth_question = $lev; @@ -1220,7 +1221,7 @@ sub fix_terminal_ternary { # Note that this padding will remain even if the terminal value goes # out on a separate line. This does not seem to look to bad, so no # mechanism has been included to undo it. - my $field1 = shift @fields; + my $field1_uu = shift @fields; my $field_length1 = shift @field_lengths; my $len_colon = length($colon); unshift @fields, ( $colon, $pad . $therest ); @@ -1657,7 +1658,7 @@ sub _flush_comment_lines { # look for excessively long lines my $max_excess = 0; foreach my $item ( @{$rgroup_lines} ) { - my ( $str, $str_len ) = @{$item}; + my ( $str_uu, $str_len ) = @{$item}; my $excess = $str_len + $leading_space_count - $group_maximum_line_length; if ( $excess > $max_excess ) { @@ -1749,7 +1750,7 @@ sub _flush_group_lines { #------------------------------------------------------------------------ # STEP 1: Remove most unmatched tokens. They block good alignments. - my ( $max_lev_diff, $saw_side_comment, $saw_signed_number ) = + my ( $max_lev_diff_uu, $saw_side_comment, $saw_signed_number ) = delete_unmatched_tokens( $rgroup_lines, $group_level ); # STEP 2: Sweep top to bottom, forming subgroups of lines with exactly @@ -1958,7 +1959,7 @@ sub _flush_group_lines { } my $j_terminal_match = $new_line->{'j_terminal_match'}; - my ( $jbeg, $jend ) = get_rgroup_jrange(); + my ( $jbeg, $jend_uu ) = get_rgroup_jrange(); if ( !defined($jbeg) ) { # safety check, shouldn't happen @@ -2342,7 +2343,8 @@ sub sweep_left_to_right { my $var = pop(@todo); $ng_beg = $var->[1]; } - my ( $raw_tok, $lev, $tag, $tok_count ) = decode_alignment_token($tok); + my ( $raw_tok, $lev, $tag_uu, $tok_count_uu ) = + decode_alignment_token($tok); push @todo, [ $i, $ng_beg, $ng_end, $raw_tok, $lev ]; } @@ -2421,7 +2423,7 @@ sub sweep_left_to_right { return if ( !defined($ngb) || $nge <= $ngb ); foreach my $ng ( $ngb .. $nge ) { - my ( $jbeg, $jend ) = @{ $rgroups->[$ng] }; + my ( $jbeg, $jend_uu ) = @{ $rgroups->[$ng] }; my $line = $rlines->[$jbeg]; my $col = $line->get_column($itok); my $move = $col_want - $col; @@ -3171,8 +3173,9 @@ EOM foreach my $i ( 0 .. $imax ) { my $tok = $rtokens->[$i]; next if ( $tok eq '#' ); # shouldn't happen - my ( $iii, $il, $ir, $raw_tok, $lev, $tag, $tok_count ) = - @{ $rhash->{$tok} }; + my ( $iii_uu, $il, $ir, $raw_tok, $lev, $tag_uu, + $tok_count ) + = @{ $rhash->{$tok} }; #------------------------------------------------------ # Here is the basic RULE: remove an unmatched alignment @@ -3506,10 +3509,10 @@ sub compare_patterns { my $group_level = $rcall_hash->{group_level}; my $tok = $rcall_hash->{tok}; - my $tok_m = $rcall_hash->{tok_m}; - my $pat = $rcall_hash->{pat}; - my $pat_m = $rcall_hash->{pat_m}; - my $pad = $rcall_hash->{pad}; +## my $tok_m = $rcall_hash->{tok_m}; + my $pat = $rcall_hash->{pat}; + my $pat_m = $rcall_hash->{pat_m}; + my $pad = $rcall_hash->{pad}; # helper routine for sub match_line_pairs to decide if patterns in two # lines match well enough..Given @@ -3526,7 +3529,7 @@ sub compare_patterns { use constant EXPLAIN_COMPARE_PATTERNS => 0; - my ( $alignment_token, $lev, $tag, $tok_count ) = + my ( $alignment_token, $lev, $tag_uu, $tok_count_uu ) = decode_alignment_token($tok); # We have to be very careful about aligning commas @@ -3710,7 +3713,7 @@ sub get_line_token_info { $i++; last if ( $i > $imax ); last if ( $tok eq '#' ); - my ( $raw_tok, $lev, $tag, $tok_count ) = + my ( $raw_tok_uu, $lev, $tag_uu, $tok_count_uu ) = @{ $all_token_info[$jj]->[$i] }; last if ( $tok eq '#' ); @@ -3756,7 +3759,7 @@ sub get_line_token_info { foreach my $tok ( @{$rtokens} ) { $itok++; last if ( $itok > $imax ); - my ( $raw_tok, $lev, $tag, $tok_count ) = + my ( $raw_tok, $lev, $tag_uu, $tok_count_uu ) = @{ $all_token_info[$jj]->[$itok] }; last if ( $raw_tok eq '#' ); foreach my $lev_test (@levs) { @@ -3962,8 +3965,8 @@ sub prune_alignment_tree { my $jm = $jp - 1; # Pull out needed values for the next line - my ( $lev_min, $lev_max, $rtoken_patterns, $rlevs, $rtoken_indexes, - $is_monotonic, $imax_true, $imax ) + my ( $lev_min_uu, $lev_max_uu, $rtoken_patterns, $rlevs, + $rtoken_indexes, $is_monotonic_uu, $imax_true_uu, $imax_uu ) = @{ $rline_values->[$jp] }; # Transfer levels and patterns for this line to the working arrays. @@ -4082,8 +4085,8 @@ sub prune_alignment_tree { last if ( !@todo_list ); my @todo_next; foreach my $np (@todo_list) { - my ( $jbeg_p, $jend_p, $np_p, $lev_p, $pat_p, $nc_beg_p, $nc_end_p, - $rindexes_p ) + my ( $jbeg_p, $jend_p, $np_p_uu, $lev_p, $pat_p_uu, $nc_beg_p, + $nc_end_p, $rindexes_p_uu ) = @{ $match_tree[$depth]->[$np] }; my $nlines_p = $jend_p - $jbeg_p + 1; @@ -4116,8 +4119,8 @@ sub prune_alignment_tree { # loop to keep or delete each child node foreach my $nc ( $nc_beg_p .. $nc_end_p ) { - my ( $jbeg_c, $jend_c, $np_c, $lev_c, $pat_c, $nc_beg_c, - $nc_end_c ) + my ( $jbeg_c, $jend_c, $np_c_uu, $lev_c_uu, $pat_c_uu, + $nc_beg_c_uu, $nc_end_c_uu ) = @{ $match_tree[ $depth + 1 ]->[$nc] }; my $nlines_c = $jend_c - $jbeg_c + 1; my $is_monotonic = $rline_values->[$jbeg_c]->[5]; @@ -4147,7 +4150,7 @@ sub prune_alignment_tree { my $imax = @{$rtokens} - 2; foreach my $i ( 0 .. $imax ) { my $tok = $rtokens->[$i]; - my ( $raw_tok, $lev, $tag, $tok_count ) = + my ( $raw_tok_uu, $lev, $tag_uu, $tok_count_uu ) = decode_alignment_token($tok); if ( $lev > $level_keep ) { push @idel, $i; @@ -4256,10 +4259,10 @@ sub Dump_tree_groups { return ( $is_marginal, $imax_align ); } - my $jmax_0 = $line_0->{'jmax'}; - my $jmax_1 = $line_1->{'jmax'}; - my $rtokens_1 = $line_1->{'rtokens'}; - my $rtokens_0 = $line_0->{'rtokens'}; + my $jmax_0 = $line_0->{'jmax'}; + my $jmax_1 = $line_1->{'jmax'}; + my $rtokens_1 = $line_1->{'rtokens'}; +## my $rtokens_0 = $line_0->{'rtokens'}; my $rfield_lengths_0 = $line_0->{'rfield_lengths'}; my $rfield_lengths_1 = $line_1->{'rfield_lengths'}; my $rpatterns_0 = $line_0->{'rpatterns'}; @@ -4278,7 +4281,7 @@ sub Dump_tree_groups { my $j0_max_pad = 0; foreach my $j ( 0 .. $jmax_1 - 2 ) { - my ( $raw_tok, $lev, $tag, $tok_count ) = + my ( $raw_tok, $lev, $tag_uu, $tok_count_uu ) = decode_alignment_token( $rtokens_1->[$j] ); if ( $raw_tok && $lev == $group_level ) { if ( !$raw_tokb ) { $raw_tokb = $raw_tok } @@ -4788,7 +4791,7 @@ sub align_side_comments { # Loop over the groups with side comments my $column_limit; foreach my $ngr (@todo) { - my ( $jbeg, $jend ) = @{ $rgroups->[$ngr] }; + my ( $jbeg, $jend_uu ) = @{ $rgroups->[$ngr] }; # Note that since all lines in a group have common alignments, we # just have to work on one of the lines (the first line). @@ -5025,7 +5028,7 @@ EOM my ( $min_unsigned_length, $max_unsigned_length, $median_unsigned_length ) = min_max_median( \@len_unsigned ); - my ( $min_signed_length, $max_signed_length, $median_signed_length ) = + my ( $min_signed_length_uu, $max_signed_length, $median_signed_length ) = min_max_median( \@len_signed ); # Skip padding if no signed numbers exceed unsigned numbers in length @@ -6649,9 +6652,9 @@ sub get_output_line_number { my $outdent_long_lines = $rinput->{outdent_long_lines}; my $rvertical_tightness_flags = $rinput->{rvertical_tightness_flags}; my $level = $rinput->{level}; - my $level_end = $rinput->{level_end}; - my $Kend = $rinput->{Kend}; - my $maximum_line_length = $rinput->{maximum_line_length}; +## my $level_end = $rinput->{level_end}; + my $Kend = $rinput->{Kend}; + my $maximum_line_length = $rinput->{maximum_line_length}; # Useful -gcs test cases for wide characters are # perl527/(method.t.2, reg_mesg.t, mime-header.t) diff --git a/perltidyrc b/perltidyrc index 3acdc7ea..11b0629e 100644 --- a/perltidyrc +++ b/perltidyrc @@ -13,7 +13,8 @@ --warn-missing-else # warn if certain of the 'unusual' variables are seen ---warn-variable-types='s r p c' +--warn-variable-types='*' ##'s r p c' +--warn-variable-exclusion-list='$self $class *_uu' # warn if call arg counts differ from sub definitions # (requires version > 20240202.04) -- 2.39.5