From 113af6e2d3f65cb73ff16bf8a7b47f0d74ed5954 Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Fri, 19 Aug 2022 16:17:29 -0700 Subject: [PATCH] remove most remaining goto's, minor optimizations --- lib/Perl/Tidy/Formatter.pm | 103 ++++++++++-------- lib/Perl/Tidy/Tokenizer.pm | 42 ++++---- lib/Perl/Tidy/VerticalAligner.pm | 178 ++++++++++++++++++------------- 3 files changed, 185 insertions(+), 138 deletions(-) diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index 64679828..63fc80d0 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -10678,8 +10678,7 @@ sub extended_ci { my $KK = $KNEXT; $KNEXT = $rLL->[$KNEXT]->[_KNEXT_SEQ_ITEM_]; - my $seqno = $rLL->[$KK]->[_TYPE_SEQUENCE_]; - my $K_opening = $K_opening_container->{$seqno}; + my $seqno = $rLL->[$KK]->[_TYPE_SEQUENCE_]; # see if we have reached the end of the current controlling container if ( $seqno_top && $seqno == $seqno_top ) { @@ -10709,20 +10708,8 @@ sub extended_ci { next; } - # Skip if requested by -bbx to avoid blinkers - if ( $rno_xci_by_seqno->{$seqno} ) { - next; - } - - # Skip if this is a -bli container (this fixes case b1065) Note: case - # b1065 is also fixed by the update for b1055, so this update is not - # essential now. But there does not seem to be a good reason to add - # xci and bli together, so the update is retained. - if ( $ris_bli_container->{$seqno} ) { - next; - } - # We are looking for opening container tokens with ci + my $K_opening = $K_opening_container->{$seqno}; next unless ( defined($K_opening) && $KK == $K_opening ); # Make sure there is a corresponding closing container @@ -10730,6 +10717,15 @@ sub extended_ci { my $K_closing = $K_closing_container->{$seqno}; next unless defined($K_closing); + # Skip if requested by -bbx to avoid blinkers + next if ( $rno_xci_by_seqno->{$seqno} ); + + # Skip if this is a -bli container (this fixes case b1065) Note: case + # b1065 is also fixed by the update for b1055, so this update is not + # essential now. But there does not seem to be a good reason to add + # xci and bli together, so the update is retained. + next if ( $ris_bli_container->{$seqno} ); + # Require different input lines. This will filter out a large number # of small hash braces and array brackets. If we accidentally filter # out an important container, it will get fixed on the next pass. @@ -11162,41 +11158,41 @@ sub collapsed_lengths { else { # Fix for b1319, b1320 - goto NOT_MULTILINE_QW; + $K_start_multiline_qw = undef; } } } - $len = $rLL->[$KK]->[_CUMULATIVE_LENGTH_] - - $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_]; + if ( defined($K_start_multiline_qw) ) { + $len = $rLL->[$KK]->[_CUMULATIVE_LENGTH_] - + $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_]; - # We may have to add the spaces of one level or ci level ... it - # depends depends on the -xci flag, the -wn flag, and if the qw - # uses a container token as the quote delimiter. + # We may have to add the spaces of one level or ci level ... it + # depends depends on the -xci flag, the -wn flag, and if the qw + # uses a container token as the quote delimiter. - # First rule: add ci if there is a $ci_level - if ($ci_level) { - $len += $rOpts_continuation_indentation; - } - - # Second rule: otherwise, look for an extra indentation level - # from the start and add one indentation level if found. - elsif ( $level > $level_start_multiline_qw ) { - $len += $rOpts_indent_columns; - } + # First rule: add ci if there is a $ci_level + if ($ci_level) { + $len += $rOpts_continuation_indentation; + } - if ( $len > $max_prong_len ) { $max_prong_len = $len } + # Second rule: otherwise, look for an extra indentation level + # from the start and add one indentation level if found. + elsif ( $level > $level_start_multiline_qw ) { + $len += $rOpts_indent_columns; + } - $last_nonblank_type = 'q'; + if ( $len > $max_prong_len ) { $max_prong_len = $len } - $K_begin_loop = $K_first + 1; + $last_nonblank_type = 'q'; - # We can skip to the next line if more tokens - next if ( $K_begin_loop > $K_last ); + $K_begin_loop = $K_first + 1; + # We can skip to the next line if more tokens + next if ( $K_begin_loop > $K_last ); + } } - NOT_MULTILINE_QW: $K_start_multiline_qw = undef; # Find the terminal token, before any side comment @@ -14673,6 +14669,15 @@ EOM return; } ## end sub check_grind_input + # This filter speeds up a critical if-test + my %quick_filter; + + BEGIN { + my @q = qw# L { ( [ R ] ) } ? : f => #; + push @q, ','; + @quick_filter{@q} = (1) x scalar(@q); + } + sub grind_batch_of_CODE { my ($self) = @_; @@ -14763,17 +14768,23 @@ EOM my @i_for_semicolon; foreach my $i ( 0 .. $max_index_to_go ) { - $iprev_to_go[$i] = $ilast_nonblank; - $inext_to_go[$i] = $i + 1; + $iprev_to_go[$i] = $ilast_nonblank; # correct value + $inext_to_go[$i] = $i + 1; # just a first guess - my $type = $types_to_go[$i]; - next if $type eq 'b'; + next if ( $types_to_go[$i] eq 'b' ); if ( $ilast_nonblank >= 0 ) { - $inext_to_go[$ilast_nonblank] = $i; + $inext_to_go[$ilast_nonblank] = $i; # correction } $ilast_nonblank = $i; + # This is an optional shortcut to save a bit of time by skipping + # most tokens. Note: the filter may need to be updated if the + # next 'if' tests are ever changed to include more token types. + next if ( !$quick_filter{ $types_to_go[$i] } ); + + my $type = $types_to_go[$i]; + # gather info needed by sub break_long_lines if ( $type_sequence_to_go[$i] ) { my $seqno = $type_sequence_to_go[$i]; @@ -14827,7 +14838,7 @@ EOM } ## end if ($seqno) elsif ( $type eq ',' ) { $comma_count_in_batch++; } - elsif ( $tokens_to_go[$i] eq '=>' ) { + elsif ( $type eq '=>' ) { if (@unmatched_opening_indexes_in_this_batch) { my $j = $unmatched_opening_indexes_in_this_batch[-1]; my $seqno = $type_sequence_to_go[$j]; @@ -19036,7 +19047,8 @@ EOM my $comma_follows_last_closing_token; $self->check_for_new_minimum_depth( $current_depth, - $parent_seqno_to_go[0] ); + $parent_seqno_to_go[0] ) + if ( $current_depth < $minimum_depth ); my $want_previous_breakpoint = -1; @@ -19669,7 +19681,8 @@ EOM # finish off any old list when depth decreases # token $i is a ')','}', or ']' - $self->check_for_new_minimum_depth( $depth, $parent_seqno_to_go[$i] ); + $self->check_for_new_minimum_depth( $depth, $parent_seqno_to_go[$i] ) + if ( $depth < $minimum_depth ); # force all outer logical containers to break after we see on # old breakpoint diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm index 7b9eb7c7..328a1b4e 100644 --- a/lib/Perl/Tidy/Tokenizer.pm +++ b/lib/Perl/Tidy/Tokenizer.pm @@ -6815,7 +6815,7 @@ sub guess_if_pattern_or_division { if ( $divide_possible < 0 ) { $msg = "pattern (division not possible here)\n"; $is_pattern = 1; - goto RETURN; + return ( $is_pattern, $msg ); } $i = $ibeg + 1; @@ -6946,8 +6946,6 @@ sub guess_if_pattern_or_division { } } } - - RETURN: return ( $is_pattern, $msg ); } ## end sub guess_if_pattern_or_division @@ -8133,6 +8131,8 @@ BEGIN { $tokenizer_self->[_in_error_] = 1; } $id_scan_state = EMPTY_STRING; + + # emergency return goto RETURN; } $saw_type = !$saw_alpha; @@ -8697,23 +8697,27 @@ sub find_next_noncomment_type { find_next_nonblank_token( $i_next, $rtokens, $max_token_index ); } - goto RETURN if ( !$next_nonblank_token || $next_nonblank_token eq SPACE ); - - # check for possible a digraph - goto RETURN if ( !defined( $rtokens->[ $i_next + 1 ] ) ); - my $test2 = $next_nonblank_token . $rtokens->[ $i_next + 1 ]; - goto RETURN if ( !$is_digraph{$test2} ); - $next_nonblank_token = $test2; - $i_next = $i_next + 1; - - # check for possible a trigraph - goto RETURN if ( !defined( $rtokens->[ $i_next + 1 ] ) ); - my $test3 = $next_nonblank_token . $rtokens->[ $i_next + 1 ]; - goto RETURN if ( !$is_trigraph{$test3} ); - $next_nonblank_token = $test3; - $i_next = $i_next + 1; + # check for a digraph + if ( $next_nonblank_token + && $next_nonblank_token ne SPACE + && defined( $rtokens->[ $i_next + 1 ] ) ) + { + my $test2 = $next_nonblank_token . $rtokens->[ $i_next + 1 ]; + if ( $is_digraph{$test2} ) { + $next_nonblank_token = $test2; + $i_next = $i_next + 1; + + # check for a trigraph + if ( defined( $rtokens->[ $i_next + 1 ] ) ) { + my $test3 = $next_nonblank_token . $rtokens->[ $i_next + 1 ]; + if ( $is_trigraph{$test3} ) { + $next_nonblank_token = $test3; + $i_next = $i_next + 1; + } + } + } + } - RETURN: return ( $next_nonblank_token, $i_next ); } ## end sub find_next_noncomment_type diff --git a/lib/Perl/Tidy/VerticalAligner.pm b/lib/Perl/Tidy/VerticalAligner.pm index 2866e650..389339d3 100644 --- a/lib/Perl/Tidy/VerticalAligner.pm +++ b/lib/Perl/Tidy/VerticalAligner.pm @@ -1314,6 +1314,13 @@ BEGIN { @is_closing_block_type{@q} = (1) x scalar(@q); } +# This is a flag for testing alignment by sub sweep_left_to_right only. +# This test can help find problems with the alignment logic. +# This flag should normally be zero. +use constant TEST_SWEEP_ONLY => 0; + +use constant EXPLAIN_CHECK_MATCH => 0; + sub check_match { # See if the current line matches the current vertical alignment group. @@ -1326,9 +1333,15 @@ sub check_match { # $prev_line = the line just before $new_line # returns a flag and a value as follows: - # return (0, $imax_align) if the line does not match - # return (1, $imax_align) if the line matches but does not fit - # return (2, $imax_align) if the line matches and fits + # return (0, $imax_align) if the line does not match + # return (1, $imax_align) if the line matches but does not fit + # return (2, $imax_align) if the line matches and fits + + use constant NO_MATCH => 0; + use constant MATCH_NO_FIT => 1; + use constant MATCH_AND_FIT => 2; + + my $return_value; # Returns '$imax_align' which is the index of the maximum matching token. # It will be used in the subsequent left-to-right sweep to align as many @@ -1337,12 +1350,6 @@ sub check_match { # variable $GoToMsg explains reason for no match, for debugging my $GoToMsg = EMPTY_STRING; - use constant EXPLAIN_CHECK_MATCH => 0; - - # This is a flag for testing alignment by sub sweep_left_to_right only. - # This test can help find problems with the alignment logic. - # This flag should normally be zero. - use constant TEST_SWEEP_ONLY => 0; my $jmax = $new_line->{'jmax'}; my $maximum_field_index = $base_line->{'jmax'}; @@ -1363,51 +1370,53 @@ sub check_match { # A group with hanging side comments ends with the first non hanging # side comment. if ( $base_line->{'is_hanging_side_comment'} ) { - $GoToMsg = "end of hanging side comments"; - goto NO_MATCH; + $GoToMsg = "end of hanging side comments"; + $return_value = NO_MATCH; } + else { - # The number of tokens that this line shares with the previous line - # has been stored with the previous line. This value was calculated - # and stored by sub 'match_line_pair'. - $imax_align = $prev_line->{'imax_pair'}; + # The number of tokens that this line shares with the previous + # line has been stored with the previous line. This value was + # calculated and stored by sub 'match_line_pair'. + $imax_align = $prev_line->{'imax_pair'}; - if ( $imax_align != $jlimit ) { - $GoToMsg = "Not all tokens match: $imax_align != $jlimit\n"; - goto NO_MATCH; + if ( $imax_align != $jlimit ) { + $GoToMsg = "Not all tokens match: $imax_align != $jlimit\n"; + $return_value = NO_MATCH; + } } - } - # The tokens match, but the lines must have identical number of - # tokens to join the group. - if ( $maximum_field_index != $jmax ) { - $GoToMsg = "token count differs"; - goto NO_MATCH; - } + if ( !defined($return_value) ) { - # The tokens match. Now See if there is space for this line in the - # current group. - if ( $self->check_fit( $new_line, $base_line ) && !TEST_SWEEP_ONLY ) { + # The tokens match, but the lines must have identical number of + # tokens to join the group. + if ( $maximum_field_index != $jmax ) { + $GoToMsg = "token count differs"; + $return_value = NO_MATCH; + } - EXPLAIN_CHECK_MATCH - && print "match and fit, imax_align=$imax_align, jmax=$jmax\n"; - return ( 2, $jlimit ); - } - else { + # The tokens match. Now See if there is space for this line in the + # current group. + elsif ( $self->check_fit( $new_line, $base_line ) && !TEST_SWEEP_ONLY ) + { - EXPLAIN_CHECK_MATCH - && print "match but no fit, imax_align=$imax_align, jmax=$jmax\n"; - return ( 1, $jlimit ); + $GoToMsg = "match and fit, imax_align=$imax_align, jmax=$jmax\n"; + $return_value = MATCH_AND_FIT; + $imax_align = $jlimit; + } + else { + $GoToMsg = "match but no fit, imax_align=$imax_align, jmax=$jmax\n"; + $return_value = MATCH_NO_FIT; + $imax_align = $jlimit; + } } - NO_MATCH: - EXPLAIN_CHECK_MATCH && print - "no match because $GoToMsg, max match index =i $imax_align, jmax=$jmax\n"; +"returning $return_value because $GoToMsg, max match index =i $imax_align, jmax=$jmax\n"; - return ( 0, $imax_align ); + return ( $return_value, $imax_align ); } sub check_fit { @@ -3118,7 +3127,7 @@ sub match_line_pairs { my ( $tok, $tok_m, $pat, $pat_m, $pad ) = @_; my $GoToMsg = EMPTY_STRING; - my $return_code = 1; + my $return_code = 0; my ( $alignment_token, $lev, $tag, $tok_count ) = decode_alignment_token($tok); @@ -3136,8 +3145,13 @@ sub match_line_pairs { # do not align commas unless they are in named # containers - $GoToMsg = "do not align commas in unnamed containers"; - goto NO_MATCH unless ( $tok =~ /[A-Za-z]/ ); + if ( $tok !~ /[A-Za-z]/ ) { + $return_code = 1; + $GoToMsg = "do not align commas in unnamed containers"; + } + else { + $return_code = 0; + } } # do not align parens unless patterns match; @@ -3146,8 +3160,13 @@ sub match_line_pairs { # But we can allow a match if the parens don't # require any padding. - $GoToMsg = "do not align '(' unless patterns match or pad=0"; - if ( $pad != 0 ) { goto NO_MATCH } + if ( $pad != 0 ) { + $return_code = 1; + $GoToMsg = "do not align '(' unless patterns match or pad=0"; + } + else { + $return_code = 0; + } } # Handle an '=' alignment with different patterns to @@ -3165,8 +3184,8 @@ sub match_line_pairs { # letter of the pattern. This is crude, but works # well enough. if ( substr( $pat_m, 0, 1 ) ne substr( $pat, 0, 1 ) ) { - $GoToMsg = "first character before equals differ"; - goto NO_MATCH; + $GoToMsg = "first character before equals differ"; + $return_code = 1; } # The introduction of sub 'prune_alignment_tree' @@ -3189,20 +3208,22 @@ sub match_line_pairs { elsif ( ( index( $pat_m, ',' ) >= 0 ) ne ( index( $pat, ',' ) >= 0 ) ) { - $GoToMsg = "mixed commas/no-commas before equals"; + $GoToMsg = "mixed commas/no-commas before equals"; + $return_code = 1; if ( $lev eq $group_level ) { $return_code = 2; } - goto NO_MATCH; + } + else { + $return_code = 0; } } - - MATCH: - return ( 0, \$GoToMsg ); - - NO_MATCH: + else { + $return_code = 0; + } EXPLAIN_COMPARE_PATTERNS + && $return_code && print STDERR "no match because $GoToMsg\n"; return ( $return_code, \$GoToMsg ); @@ -3952,16 +3973,24 @@ sub Dump_tree_groups { my $is_marginal = 0; - # always keep alignments of a terminal else or ternary - goto RETURN if ( defined( $line_1->{'j_terminal_match'} ) ); + #--------------------------------------- + # Always align certain special cases ... + #--------------------------------------- + if ( + + # always keep alignments of a terminal else or ternary + defined( $line_1->{'j_terminal_match'} ) - # always align lists - my $group_list_type = $line_0->{'list_type'}; - goto RETURN if ($group_list_type); + # always align lists + || $line_0->{'list_type'} - # always align hanging side comments - my $is_hanging_side_comment = $line_1->{'is_hanging_side_comment'}; - goto RETURN if ($is_hanging_side_comment); + # always align hanging side comments + || $line_1->{'is_hanging_side_comment'} + + ) + { + return ( $is_marginal, $imax_align ); + } my $jmax_0 = $line_0->{'jmax'}; my $jmax_1 = $line_1->{'jmax'}; @@ -4099,10 +4128,12 @@ sub Dump_tree_groups { && $jmax_1 == 2 && $sc_term0 ne $sc_term1; - ######################################## - # return unless this is a marginal match - ######################################## - goto RETURN if ( !$is_marginal ); + #--------------------------------------- + # return if this is not a marginal match + #--------------------------------------- + if ( !$is_marginal ) { + return ( $is_marginal, $imax_align ); + } # Undo the marginal match flag in certain cases, @@ -4128,9 +4159,9 @@ sub Dump_tree_groups { my $pat0 = $rpatterns_0->[0]; my $pat1 = $rpatterns_1->[0]; - ########################################################## + #--------------------------------------------------------- # Turn off the marginal flag for some types of assignments - ########################################################## + #--------------------------------------------------------- if ( $is_assignment{$raw_tokb} ) { # undo marginal flag if first line is semicolon terminated @@ -4153,9 +4184,9 @@ sub Dump_tree_groups { } } - ###################################################### + #----------------------------------------------------- # Turn off the marginal flag if we saw an 'if' or 'or' - ###################################################### + #----------------------------------------------------- # A trailing 'if' and 'or' often gives a good alignment # For example, we can align these: @@ -4182,9 +4213,9 @@ sub Dump_tree_groups { $imax_align = $jfirst_bad - 1; } - ########################################################### + #---------------------------------------------------------- # Allow sweep to match lines with leading '=' in some cases - ########################################################### + #---------------------------------------------------------- if ( $imax_align < 0 && defined($j0_eq_pad) ) { if ( @@ -4233,10 +4264,9 @@ sub Dump_tree_groups { } } - RETURN: return ( $is_marginal, $imax_align ); } -} +} ## end closure for sub is_marginal_match sub get_extra_leading_spaces { -- 2.39.5