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 ) {
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
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.
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
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) = @_;
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];
} ## 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];
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;
# 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
@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.
# $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
# 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'};
# 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 {
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);
# 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;
# 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
# 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'
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 );
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'};
&& $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,
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
}
}
- ######################################################
+ #-----------------------------------------------------
# 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:
$imax_align = $jfirst_bad - 1;
}
- ###########################################################
+ #----------------------------------------------------------
# Allow sweep to match lines with leading '=' in some cases
- ###########################################################
+ #----------------------------------------------------------
if ( $imax_align < 0 && defined($j0_eq_pad) ) {
if (
}
}
- RETURN:
return ( $is_marginal, $imax_align );
}
-}
+} ## end closure for sub is_marginal_match
sub get_extra_leading_spaces {
projects / perltidy.git / commitdiff