From: Steve Hancock Date: Sat, 1 Dec 2018 20:56:35 +0000 (-0800) Subject: minor code cleanups X-Git-Tag: 20190601~55 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=8a17c6e84de31d3db7cc5ad413a036f749100a67;p=perltidy.git minor code cleanups --- diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index d1a975ca..8d53eeec 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -209,7 +209,7 @@ EOM sub find_input_line_ending { # Peek at a file and return first line ending character. - # Quietly return undef in case of any trouble. + # Return undefined value in case of any trouble. my ($input_file) = @_; my $ending; @@ -254,7 +254,6 @@ sub catfile { my @parts = @_; - #BEGIN { eval "require File::Spec"; $missing_file_spec = $@; } BEGIN { eval { require File::Spec }; $missing_file_spec = $@; @@ -267,7 +266,7 @@ sub catfile { # Perl 5.004 systems may not have File::Spec so we'll make # a simple try. We assume File::Basename is available. - # return undef if not successful. + # return if not successful. my $name = pop @parts; my $path = join '/', @parts; my $test_file = $path . $name; @@ -2254,39 +2253,6 @@ sub process_command_line { } } -# This is the original coding, which worked, -# but I've rewritten it (above) to keep Perl-Critic from complaining -# Keep for awhile. - -=pod -sub process_command_line { - - my ( - $perltidyrc_stream, $is_Windows, $Windows_type, - $rpending_complaint, $dump_options_type - ) = @_; - - my $use_cache = !defined($perltidyrc_stream) && !$dump_options_type; - if ($use_cache) { - my $cache_key = join( chr(28), @ARGV ); - if ( my $result = $process_command_line_cache{$cache_key} ) { - my ( $argv, @retvals ) = @{$result}; - @ARGV = @{$argv}; - return @retvals; - } - else { - my @retvals = _process_command_line(@_); - $process_command_line_cache{$cache_key} = [ \@ARGV, @retvals ] - if $retvals[0]->{'memoize'}; - return @retvals; - } - } - else { - return _process_command_line(@_); - } -} -=cut - # (note the underscore here) sub _process_command_line { @@ -2607,11 +2573,13 @@ sub check_options { $rOpts->{'check-syntax'} = 0; } + ########################################################################### # Added Dec 2017: Deactivating check-syntax for all systems for safety # because unexpected results can occur when code in BEGIN blocks is # executed. This flag was included to help check for perltidy mistakes, # and may still be useful for debugging. To activate for testing comment - # out the next three lines. + # out the next three lines. Also fix sub 'do_check_syntax' in this file. + ########################################################################### else { $rOpts->{'check-syntax'} = 0; } @@ -3830,7 +3798,6 @@ sub check_syntax { # the perl version number will be helpful for diagnosing the problem $logger_object->write_logfile_entry( $^V . "\n" ); - ##qx/perl -v $error_redirection/ . "\n" ); } } else { diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index 15a747ec..ea70df4c 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -1022,7 +1022,6 @@ sub break_lines { # let logger see all non-blank lines of code my $output_line_number = get_output_line_number(); - ##$vertical_aligner_object->get_output_line_number(); black_box( $line_of_tokens, $output_line_number ); } @@ -2874,6 +2873,7 @@ sub dump_tokens { print STDERR "ntokens=$nvars\n"; print STDERR "K\t_TOKEN_\t_TYPE_\n"; my $K = 0; + foreach my $item ( @{$rLL} ) { print STDERR "$K\t$item->[_TOKEN_]\t$item->[_TYPE_]\n"; $K++; @@ -3070,14 +3070,14 @@ sub weld_cuddled_blocks { my $length_to_opening_seqno = sub { my ($seqno) = @_; - my $KK = $K_opening_container->{$seqno}; - my $lentot = $KK <= 0 ? 0 : $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_]; + my $KK = $K_opening_container->{$seqno}; + my $lentot = $KK <= 0 ? 0 : $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_]; return $lentot; }; my $length_to_closing_seqno = sub { my ($seqno) = @_; - my $KK = $K_closing_container->{$seqno}; - my $lentot = $KK <= 0 ? 0 : $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_]; + my $KK = $K_closing_container->{$seqno}; + my $lentot = $KK <= 0 ? 0 : $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_]; return $lentot; }; @@ -3256,16 +3256,15 @@ sub weld_nested_containers { my $length_to_opening_seqno = sub { my ($seqno) = @_; - my $KK = $K_opening_container->{$seqno}; - my $lentot = $KK <= 0 ? 0 : $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_]; + my $KK = $K_opening_container->{$seqno}; + my $lentot = $KK <= 0 ? 0 : $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_]; return $lentot; }; my $length_to_closing_seqno = sub { my ($seqno) = @_; - my $KK = $K_closing_container->{$seqno}; - my $lentot = $KK <= 0 ? 0 : $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_]; - ##my $lentot = $rLL->[$KK]->[_CUMULATIVE_LENGTH_]; + my $KK = $K_closing_container->{$seqno}; + my $lentot = $KK <= 0 ? 0 : $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_]; return $lentot; }; @@ -6376,7 +6375,6 @@ EOM # No longer doing this: also write a line which is entirely a 'qw' list # to allow stacking of opening and closing tokens. Note that interior # qw lines will still go out at the end of this routine. - ##if ( $rOpts->{'indent-only'} ) { if ( $CODE_type eq 'IO' ) { $self->flush(); my $line = $input_line; @@ -7096,7 +7094,6 @@ sub output_line_to_go { $want_blank = $rOpts->{'blanks-before-blocks'} && $lc >= $rOpts->{'long-block-line-count'} - ##&& $file_writer_object->get_consecutive_nonblank_lines() >= && consecutive_nonblank_lines() >= $rOpts->{'long-block-line-count'} && ( @@ -9358,9 +9355,8 @@ sub send_lines_to_vertical_aligner { # These are used below to prevent unwanted cross-line alignments. # Unbalanced containers already avoid aligning across # container boundaries. - ##if ( $tokens_to_go[$i] eq '(' ) { - my $tok=$tokens_to_go[$i]; - if ( $tok =~ /^[\(\{\[]/ ) { #'(' ) { + my $tok = $tokens_to_go[$i]; + if ( $tok =~ /^[\(\{\[]/ ) { #'(' ) { # if container is balanced on this line... my $i_mate = $mate_index_to_go[$i]; @@ -9375,15 +9371,16 @@ sub send_lines_to_vertical_aligner { # within this container, and it helps avoid undesirable # alignments of different types of containers. - # Containers beginning with { and [ are given those names - # for uniqueness. That way commas in different containers - # will not match. Here is an example of what this prevents: - # a => [ 1, 2, 3 ], - # b => { b1 => 4, b2 => 5 }, - # Here is another example of what avoid by labeling the commas properly: - # is_deeply( [ $a, $a ], [ $b, $c ] ); - # is_deeply( { foo => $a, bar => $a }, { foo => $b, bar => $c } ); - # is_deeply( [ \$a, \$a ], [ \$b, \$c ] ); + # Containers beginning with { and [ are given those names + # for uniqueness. That way commas in different containers + # will not match. Here is an example of what this prevents: + # a => [ 1, 2, 3 ], + # b => { b1 => 4, b2 => 5 }, + # Here is another example of what we avoid by labeling the + # commas properly: + # is_d( [ $a, $a ], [ $b, $c ] ); + # is_d( { foo => $a, bar => $a }, { foo => $b, bar => $c } ); + # is_d( [ \$a, \$a ], [ \$b, \$c ] ); my $name = $tok; if ( $tok eq '(' ) { @@ -9433,7 +9430,7 @@ sub send_lines_to_vertical_aligner { } } ##elsif ( $tokens_to_go[$i] eq ')' ) { - elsif ( $tokens_to_go[$i] =~ /^[\)\}\]]/ ) { + elsif ( $tokens_to_go[$i] =~ /^[\)\}\]]/ ) { $depth-- if $depth > 0; } @@ -10866,7 +10863,7 @@ sub get_seqno { #-------------------------------------------------------- # patch for =~ operator. We only align this if it # is the first operator in a line, and the line is a simple - # statement. Aligning them within a statement + # statement. Aligning them within a statement # interferes could interfere with other good alignments. #-------------------------------------------------------- if ( $alignment_type eq '=~' ) { @@ -13050,6 +13047,7 @@ sub find_token_starting_list { my $im3 = $i_opening_paren - 3; my $typem1 = $types_to_go[$im1]; my $typem2 = $im2 >= 0 ? $types_to_go[$im2] : 'b'; + if ( $typem1 eq ',' || ( $typem1 eq 'b' && $typem2 eq ',' ) ) { $i_opening_minus = $i_opening_paren; } @@ -13948,6 +13946,7 @@ sub get_maximum_fields_wanted { my $total_variation_1 = 0; my $total_variation_2 = 0; my @total_variation_2 = ( 0, 0 ); + foreach my $j ( 0 .. $item_count - 1 ) { $is_odd = 1 - $is_odd; diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm index dc41254f..d18d1a36 100644 --- a/lib/Perl/Tidy/Tokenizer.pm +++ b/lib/Perl/Tidy/Tokenizer.pm @@ -1087,15 +1087,13 @@ sub prepare_for_a_new_file { # variables used to track depths of various containers # and report nesting errors - $paren_depth = 0; - $brace_depth = 0; - $square_bracket_depth = 0; - @current_depth[ 0 .. $#closing_brace_names ] = - (0) x scalar @closing_brace_names; - $total_depth = 0; - @total_depth = (); - @nesting_sequence_number[ 0 .. $#closing_brace_names ] = - ( 0 .. $#closing_brace_names ); + $paren_depth = 0; + $brace_depth = 0; + $square_bracket_depth = 0; + @current_depth = (0) x scalar @closing_brace_names; + $total_depth = 0; + @total_depth = (); + @nesting_sequence_number = ( 0 .. @closing_brace_names - 1 ); @current_sequence_number = (); $paren_type[$paren_depth] = ''; $paren_semicolon_count[$paren_depth] = 0; @@ -4645,7 +4643,7 @@ sub decide_if_code_block { # find the closing quote; don't worry about escapes my $quote_mark = $pre_types[$j]; - foreach my $k ( $j + 1 .. $#pre_types - 1 ) { + foreach my $k ( $j + 1 .. @pre_types - 2 ) { if ( $pre_types[$k] eq $quote_mark ) { $j = $k + 1; my $next = $pre_types[$j]; @@ -4830,7 +4828,7 @@ sub increase_nesting_depth { $starting_line_of_current_depth[$aa][ $current_depth[$aa] ] = [ $input_line_number, $input_line, $pos ]; - for my $bb ( 0 .. $#closing_brace_names ) { + for my $bb ( 0 .. @closing_brace_names - 1 ) { next if ( $bb == $aa ); $depth_array[$aa][$bb][ $current_depth[$aa] ] = $current_depth[$bb]; } @@ -4877,7 +4875,7 @@ sub decrease_nesting_depth { $statement_type = $nested_statement_type[$aa][ $current_depth[$aa] ]; # check that any brace types $bb contained within are balanced - for my $bb ( 0 .. $#closing_brace_names ) { + for my $bb ( 0 .. @closing_brace_names - 1 ) { next if ( $bb == $aa ); unless ( $depth_array[$aa][$bb][ $current_depth[$aa] ] == @@ -4957,7 +4955,7 @@ sub check_final_nesting_depths { # USES GLOBAL VARIABLES: @current_depth, @starting_line_of_current_depth - for my $aa ( 0 .. $#closing_brace_names ) { + for my $aa ( 0 .. @closing_brace_names - 1 ) { if ( $current_depth[$aa] ) { my $rsl = @@ -6548,7 +6546,7 @@ sub find_angle_operator_termination { # <$LATEX2HTMLVERSIONS${dd}html[1-9].[0-9].pl> # # Here are some examples of lines which do not have angle operators: - # return undef unless $self->[2]++ < $#{$self->[1]}; + # return unless $self->[2]++ < $#{$self->[1]}; # < 2 || @$t > # # the following line from dlister.pl caused trouble: @@ -6826,7 +6824,6 @@ sub find_here_doc { } } else { # found ending quote - ##my $j; $found_target = 1; my $tokj; diff --git a/lib/Perl/Tidy/VerticalAligner.pm b/lib/Perl/Tidy/VerticalAligner.pm index 1bb1a18c..699a98a6 100644 --- a/lib/Perl/Tidy/VerticalAligner.pm +++ b/lib/Perl/Tidy/VerticalAligner.pm @@ -385,7 +385,7 @@ sub valign_input { # number of fields is $jmax # number of tokens between fields is $jmax-1 - my $jmax = @{$rfields}-1; + my $jmax = @{$rfields} - 1; my $leading_space_count = get_spaces($indentation); @@ -413,7 +413,7 @@ sub valign_input { my $nlines = @group_lines; print STDOUT "APPEND0: entering lines=$nlines new #fields= $jmax, leading_count=$leading_space_count last_cmt=$last_comment_column force=$is_forced_break, level_jump=$level_jump, level=$level, group_level=$group_level, level_jump=$level_jump\n"; - }; + }; # Validate cached line if necessary: If we can produce a container # with just 2 lines total by combining an existing cached opening @@ -574,9 +574,9 @@ sub valign_input { # programming check: (shouldn't happen) # an error here implies an incorrect call was made - if ( @{$rfields} && ( @{$rtokens} != ( @{$rfields}- 1 ) ) ) { - my $nt=@{$rtokens}; - my $nf=@{$rfields}; + if ( @{$rfields} && ( @{$rtokens} != ( @{$rfields} - 1 ) ) ) { + my $nt = @{$rtokens}; + my $nf = @{$rfields}; warning( "Program bug in Perl::Tidy::VerticalAligner - number of tokens = $nt should be one less than number of fields: $nf)\n" ); @@ -635,7 +635,7 @@ sub valign_input { } # Force break after jump to lower level - if ( $level_jump < 0 ) { + if ( $level_jump < 0 ) { my_flush(); } @@ -2033,7 +2033,7 @@ sub my_flush { my $nlines = @group_lines; print STDOUT "APPEND0: my_flush called from $a $b $c lines=$nlines, type=$group_type \n"; - }; + }; # handle a group of COMMENT lines if ( $group_type eq 'COMMENT' ) { my_flush_comment() } @@ -2060,7 +2060,7 @@ sub my_flush { add_to_group($new_line); # flush if no side comment and no matching token. This prevents - # this line from pushing sidecoments out to the right. + # this line from pushing sidecoments out to the right. if ( no_matching_tokens($new_line) ) { my_flush_code() } next; } @@ -2090,7 +2090,7 @@ sub my_flush { # ------------------------------------------------------------- if ( $new_line->get_is_hanging_side_comment() ) { - join_hanging_comment( $new_line, $base_line ) + join_hanging_comment( $new_line, $base_line ); } # flush if no side comment and no matching token. This prevents @@ -2200,6 +2200,7 @@ EOM my $kmax = @{$ridel} - 1; my $k = 0; my $jdel_next = $ridel->[$k]; + # FIXME: if ( $jdel_next < 0 ) { print STDERR "bad jdel_next=$jdel_next\n"; return } my $pattern = $rpatterns_old->[0]; @@ -2222,7 +2223,8 @@ EOM my $jdel_last = $jdel_next; $jdel_next = $ridel->[$k]; if ( $jdel_next < $jdel_last ) { - # FIXME: + + # FIXME: print STDERR "bad jdel_next=$jdel_next\n"; return; } @@ -2322,11 +2324,11 @@ sub remove_unmatched_tokens { my $rhash = {}; my $rtokens = $line->get_rtokens(); my $i = 0; - my $i_eq; + my $i_eq; foreach my $tok ( @{$rtokens} ) { $rhash->{$tok} = [ $i, undef, undef ]; - # remember the first equals at line level + # remember the first equals at line level if ( !defined($i_eq) && $tok =~ /^=(\d+)/ ) { my $lev = $1; if ( $lev eq $group_level ) { $i_eq = $i } @@ -2365,9 +2367,10 @@ sub remove_unmatched_tokens { my $i = 0; my $nl = 0; my $nr = 0; - my $i_eq = $i_equals[$jj]; + my $i_eq = $i_equals[$jj]; my @idel; my $imax = @{$rtokens} - 2; + for ( my $i = 0 ; $i <= $imax ; $i++ ) { my $tok = $rtokens->[$i]; next if ( $tok eq '#' ); # shouldn't happen