From: Steve Hancock Date: Sat, 24 Dec 2022 22:53:35 +0000 (-0800) Subject: divide sub recombine_breakpoints into two parts X-Git-Tag: 20221112.03~6 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=067aa278698a4e3565785c61bf66367366a49d77;p=perltidy.git divide sub recombine_breakpoints into two parts --- diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index d0353293..5a77c5af 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -17747,9 +17747,6 @@ sub break_equals { # do nothing under extreme stress return if ( $high_stress_level < 1 ); - my $rK_weld_right = $self->[_rK_weld_right_]; - my $rK_weld_left = $self->[_rK_weld_left_]; - my $nmax_start = @{$ri_end} - 1; return if ( $nmax_start <= 0 ); @@ -17822,7 +17819,7 @@ sub break_equals { # This is potentially an O(n-squared) loop, but not critical, so we can # put a finite limit on the total number of iterations. This is # suggested by issue c118, which pushed about 5.e5 lines through here - # and caused an excessive run time. + # and caused an excessive run time. For another test case see c167. # Three lines of defense have been put in place to prevent excessive # run times: @@ -17856,311 +17853,365 @@ sub break_equals { # numbers, and the line numbers change as we go. while ( my $section = pop @{$rsections} ) { my ( $nbeg, $nend ) = @{$section}; + $it_count = $self->recombine_breakpoints_section_loop( - # number of ending lines to leave untouched in this pass - my $nmax_sec = @{$ri_end} - 1; - my $num_freeze = $nmax_sec - $nend; + $ri_beg, + $ri_end, + $nbeg, + $nend, + $it_count, + $it_count_max, + \@joint, + $rbond_strength_to_go - my $more_to_do = 1; + ); + last if ( !defined($it_count) ); + } - # We keep looping over all of the lines of this batch - # until there are no more possible recombinations - my $nmax_last = $nmax_sec + 1; - my $reverse = 0; + if (DEBUG_RECOMBINE) { + my $nmax_last = @{$ri_end} - 1; + if ( !defined($it_count) ) { $it_count = 'UNDEF' } + print STDERR +"exiting recombine with $nmax_last lines, starting lines=$nmax_start, iterations=$it_count, max_it=$it_count_max numsec=$num_sections\n"; + } + return; + } ## end sub recombine_breakpoints - while ($more_to_do) { + sub recombine_breakpoints_section_loop { + my ( + $self, + + $ri_beg, + $ri_end, + $nbeg, + $nend, + $it_count, + $it_count_max, + $rjoint, + $rbond_strength_to_go, - # Emergency return on excess total iterations. The allowed - # maximum is large enough that this should never happen. - $it_count++; - if ( $it_count > $it_count_max ) { - my $KK = $K_to_go[0]; - my $lno = $self->[_rLL_]->[$KK]->[_LINE_INDEX_]; - DEVEL_MODE && Fault(<[_rK_weld_right_]; + my $rK_weld_left = $self->[_rK_weld_left_]; + + # number of ending lines to leave untouched in this pass + my $nmax_sec = @{$ri_end} - 1; + my $num_freeze = $nmax_sec - $nend; + + my $more_to_do = 1; + + # We keep looping over all of the lines of this batch + # until there are no more possible recombinations + my $nmax_last = $nmax_sec + 1; + my $reverse = 0; + + while ($more_to_do) { + + # Emergency return on excess total iterations. The allowed + # maximum is large enough that this should never happen. + $it_count++; + if ( $it_count > $it_count_max ) { + my $KK = $K_to_go[0]; + my $lno = $self->[_rLL_]->[$KK]->[_LINE_INDEX_]; + DEVEL_MODE && Fault(<[_rLL_]->[$KK]->[_LINE_INDEX_]; - Fault( + # Safety check for infinite loop: the line count must decrease + unless ( $nmax < $nmax_last ) { + + # Shouldn't happen because splice below decreases nmax on + # each iteration. An error can only be due to a recent + # programming change. We better stop here. + if (DEVEL_MODE) { + my $KK = $K_to_go[0]; + my $lno = $self->[_rLL_]->[$KK]->[_LINE_INDEX_]; + Fault( "Program bug-infinite loop in recombine breakpoints near line $lno\n" - ); - } - $more_to_do = 0; - goto RETURN; + ); } - $nmax_last = $nmax; $more_to_do = 0; - # Count lines with leading &&, ||, :, at any level. - # This is used to avoid some recombinations which might - # be hard to read. - my $rleading_amp_count; - ${$rleading_amp_count} = 0; - - my $this_line_is_semicolon_terminated; - - # loop over all remaining lines in this batch - my $nstop = $nmax - $num_freeze; - for my $iter ( $nbeg + 1 .. $nstop ) { - - # alternating sweep direction gives symmetric results - # for recombining lines which exceed the line length - # such as eval {{{{.... }}}} - my $n; - if ($reverse) { $n = $nbeg + 1 + $nstop - $iter; } - else { $n = $iter } - - #---------------------------------------------------------- - # If we join the current pair of lines, - # line $n-1 will become the left part of the joined line - # line $n will become the right part of the joined line - # - # Here are Indexes of the endpoint tokens of the two lines: - # - # -----line $n-1--- | -----line $n----- - # $ibeg_1 $iend_1 | $ibeg_2 $iend_2 - # ^ - # | - # We want to decide if we should remove the line break - # between the tokens at $iend_1 and $ibeg_2 - # - # We will apply a number of ad-hoc tests to see if joining - # here will look ok. The code will just move to the next - # pair if the join doesn't look good. If we get through - # the gauntlet of tests, the lines will be recombined. - #---------------------------------------------------------- - # - # beginning and ending tokens of the lines we are working on - my $ibeg_1 = $ri_beg->[ $n - 1 ]; - my $iend_1 = $ri_end->[ $n - 1 ]; - my $iend_2 = $ri_end->[$n]; - my $ibeg_2 = $ri_beg->[$n]; - my $ibeg_nmax = $ri_beg->[$nmax]; - - # combined line cannot be too long - my $excess = - $self->excess_line_length( $ibeg_1, $iend_2, 1 ); - next if ( $excess > 0 ); - - my $type_iend_1 = $types_to_go[$iend_1]; - my $type_iend_2 = $types_to_go[$iend_2]; - my $type_ibeg_1 = $types_to_go[$ibeg_1]; - my $type_ibeg_2 = $types_to_go[$ibeg_2]; - - # terminal token of line 2 if any side comment is ignored: - my $iend_2t = $iend_2; - my $type_iend_2t = $type_iend_2; - - DEBUG_RECOMBINE > 1 && do { - print STDERR -"RECOMBINE: n=$n nmax=$nmax imid=$iend_1 if=$ibeg_1 type=$type_ibeg_1 =$tokens_to_go[$ibeg_1] next_type=$type_ibeg_2 next_tok=$tokens_to_go[$ibeg_2]\n"; - }; + #------------- + # ERROR return + #------------- + return; + } + $nmax_last = $nmax; + $more_to_do = 0; - # If line $n is the last line, we set some flags and - # do any special checks for it - if ( $n == $nmax ) { + # Count lines with leading &&, ||, :, at any level. + # This is used to avoid some recombinations which might + # be hard to read. + my $rleading_amp_count; + ${$rleading_amp_count} = 0; - if ( $type_ibeg_2 eq '{' ) { + my $this_line_is_semicolon_terminated; - # join isolated ')' and '{' if requested (git #110) - if ( $rOpts_cuddled_paren_brace - && $type_iend_1 eq '}' - && $iend_1 == $ibeg_1 - && $ibeg_2 == $iend_2 ) - { - if ( $tokens_to_go[$iend_1] eq ')' - && $tokens_to_go[$ibeg_2] eq '{' ) - { - $n_best = $n; - last; - } - } + # loop over all remaining lines in this batch + my $nstop = $nmax - $num_freeze; + for my $iter ( $nbeg + 1 .. $nstop ) { - # otherwise, a terminal '{' should stay where it is - # unless preceded by a fat comma - next if ( $type_iend_1 ne '=>' ); - } + # alternating sweep direction gives symmetric results + # for recombining lines which exceed the line length + # such as eval {{{{.... }}}} + my $n; + if ($reverse) { $n = $nbeg + 1 + $nstop - $iter; } + else { $n = $iter } + + #---------------------------------------------------------- + # If we join the current pair of lines, + # line $n-1 will become the left part of the joined line + # line $n will become the right part of the joined line + # + # Here are Indexes of the endpoint tokens of the two lines: + # + # -----line $n-1--- | -----line $n----- + # $ibeg_1 $iend_1 | $ibeg_2 $iend_2 + # ^ + # | + # We want to decide if we should remove the line break + # between the tokens at $iend_1 and $ibeg_2 + # + # We will apply a number of ad-hoc tests to see if joining + # here will look ok. The code will just move to the next + # pair if the join doesn't look good. If we get through + # the gauntlet of tests, the lines will be recombined. + #---------------------------------------------------------- + # + # beginning and ending tokens of the lines we are working on + my $ibeg_1 = $ri_beg->[ $n - 1 ]; + my $iend_1 = $ri_end->[ $n - 1 ]; + my $iend_2 = $ri_end->[$n]; + my $ibeg_2 = $ri_beg->[$n]; + my $ibeg_nmax = $ri_beg->[$nmax]; + + # combined line cannot be too long + my $excess = $self->excess_line_length( $ibeg_1, $iend_2, 1 ); + next if ( $excess > 0 ); + + my $type_iend_1 = $types_to_go[$iend_1]; + my $type_iend_2 = $types_to_go[$iend_2]; + my $type_ibeg_1 = $types_to_go[$ibeg_1]; + my $type_ibeg_2 = $types_to_go[$ibeg_2]; + + # terminal token of line 2 if any side comment is ignored: + my $iend_2t = $iend_2; + my $type_iend_2t = $type_iend_2; + + DEBUG_RECOMBINE > 1 && do { + print STDERR +"RECOMBINE: n=$n nmax=$nmax imid=$iend_1 if=$ibeg_1 type=$type_ibeg_1 =$tokens_to_go[$ibeg_1] next_type=$type_ibeg_2 next_tok=$tokens_to_go[$ibeg_2]\n"; + }; - if ( $type_iend_2 eq '#' - && $iend_2 - $ibeg_2 >= 2 - && $types_to_go[ $iend_2 - 1 ] eq 'b' ) + # If line $n is the last line, we set some flags and + # do any special checks for it + if ( $n == $nmax ) { + + if ( $type_ibeg_2 eq '{' ) { + + # join isolated ')' and '{' if requested (git #110) + if ( $rOpts_cuddled_paren_brace + && $type_iend_1 eq '}' + && $iend_1 == $ibeg_1 + && $ibeg_2 == $iend_2 ) { - $iend_2t = $iend_2 - 2; - $type_iend_2t = $types_to_go[$iend_2t]; + if ( $tokens_to_go[$iend_1] eq ')' + && $tokens_to_go[$ibeg_2] eq '{' ) + { + $n_best = $n; + last; + } } - $this_line_is_semicolon_terminated = - $type_iend_2t eq ';'; + # otherwise, a terminal '{' should stay where it is + # unless preceded by a fat comma + next if ( $type_iend_1 ne '=>' ); } - #---------------------------------------------------------- - # Recombine Section 0: - # Examine the special token joining this line pair, if any. - # Put as many tests in this section to avoid duplicate code - # and to make formatting independent of whether breaks are - # to the left or right of an operator. - #---------------------------------------------------------- - - # Note that parens around ($itok) are essential here: - my ($itok) = @{ $joint[$n] }; - if ($itok) { - my $ok_0 = - recombine_section_0( $itok, $ri_beg, $ri_end, $n, - $rleading_amp_count ); - next if ( !$ok_0 ); - } - - #---------------------------------------------------------- - # Recombine Section 1: - # Join welded nested containers immediately - #---------------------------------------------------------- - - if ( - $total_weld_count - && ( $type_sequence_to_go[$iend_1] - && defined( $rK_weld_right->{ $K_to_go[$iend_1] } ) - || $type_sequence_to_go[$ibeg_2] - && defined( $rK_weld_left->{ $K_to_go[$ibeg_2] } ) ) - ) + if ( $type_iend_2 eq '#' + && $iend_2 - $ibeg_2 >= 2 + && $types_to_go[ $iend_2 - 1 ] eq 'b' ) { - $n_best = $n; - last; + $iend_2t = $iend_2 - 2; + $type_iend_2t = $types_to_go[$iend_2t]; } - $reverse = 0; + $this_line_is_semicolon_terminated = $type_iend_2t eq ';'; + } - #---------------------------------------------------------- - # Recombine Section 2: - # Examine token at $iend_1 (right end of first line of pair) - #---------------------------------------------------------- + #---------------------------------------------------------- + # Recombine Section 0: + # Examine the special token joining this line pair, if any. + # Put as many tests in this section to avoid duplicate code + # and to make formatting independent of whether breaks are + # to the left or right of an operator. + #---------------------------------------------------------- - my ( $ok_2, $skip_Section_3 ) = - recombine_section_2( $ri_beg, $ri_end, $n, - $this_line_is_semicolon_terminated, + # Note that parens around ($itok) are essential here: + my ($itok) = @{ $rjoint->[$n] }; + if ($itok) { + my $ok_0 = + recombine_section_0( $itok, $ri_beg, $ri_end, $n, $rleading_amp_count ); - next if ( !$ok_2 ); - - #---------------------------------------------------------- - # Recombine Section 3: - # Examine token at $ibeg_2 (left end of second line of pair) - #---------------------------------------------------------- - - # Join lines identified above as capable of - # causing an outdented line with leading closing paren. - # Note that we are skipping the rest of this section - # and the rest of the loop to do the join. - if ($skip_Section_3) { - $forced_breakpoint_to_go[$iend_1] = 0; - $n_best = $n; - last; - } + next if ( !$ok_0 ); + } - my ( $ok_3, $bs_tweak ) = - recombine_section_3( $ri_beg, $ri_end, $n, - $this_line_is_semicolon_terminated, - $rleading_amp_count ); - next if ( !$ok_3 ); + #---------------------------------------------------------- + # Recombine Section 1: + # Join welded nested containers immediately + #---------------------------------------------------------- + + if ( + $total_weld_count + && ( $type_sequence_to_go[$iend_1] + && defined( $rK_weld_right->{ $K_to_go[$iend_1] } ) + || $type_sequence_to_go[$ibeg_2] + && defined( $rK_weld_left->{ $K_to_go[$ibeg_2] } ) ) + ) + { + $n_best = $n; + last; + } + + $reverse = 0; + + #---------------------------------------------------------- + # Recombine Section 2: + # Examine token at $iend_1 (right end of first line of pair) + #---------------------------------------------------------- + + my ( $ok_2, $skip_Section_3 ) = + recombine_section_2( $ri_beg, $ri_end, $n, + $this_line_is_semicolon_terminated, + $rleading_amp_count ); + next if ( !$ok_2 ); + + #---------------------------------------------------------- + # Recombine Section 3: + # Examine token at $ibeg_2 (left end of second line of pair) + #---------------------------------------------------------- - #---------------------------------------------------------- - # Recombine Section 4: - # Combine the lines if we arrive here and it is possible - #---------------------------------------------------------- + # Join lines identified above as capable of + # causing an outdented line with leading closing paren. + # Note that we are skipping the rest of this section + # and the rest of the loop to do the join. + if ($skip_Section_3) { + $forced_breakpoint_to_go[$iend_1] = 0; + $n_best = $n; + last; + } + + my ( $ok_3, $bs_tweak ) = + recombine_section_3( $ri_beg, $ri_end, $n, + $this_line_is_semicolon_terminated, + $rleading_amp_count ); + next if ( !$ok_3 ); - # honor hard breakpoints - next if ( $forced_breakpoint_to_go[$iend_1] > 0 ); + #---------------------------------------------------------- + # Recombine Section 4: + # Combine the lines if we arrive here and it is possible + #---------------------------------------------------------- - my $bs = $rbond_strength_to_go->[$iend_1] + $bs_tweak; + # honor hard breakpoints + next if ( $forced_breakpoint_to_go[$iend_1] > 0 ); - # Require a few extra spaces before recombining lines if we - # are at an old breakpoint unless this is a simple list or - # terminal line. The goal is to avoid oscillating between - # two quasi-stable end states. For example this snippet - # caused problems: + my $bs = $rbond_strength_to_go->[$iend_1] + $bs_tweak; + + # Require a few extra spaces before recombining lines if we + # are at an old breakpoint unless this is a simple list or + # terminal line. The goal is to avoid oscillating between + # two quasi-stable end states. For example this snippet + # caused problems: ## my $this = ## bless { ## TText => "[" . ( join ',', map { "\"$_\"" } split "\n", $_ ) . "]" ## }, ## $type; + next + if ( $old_breakpoint_to_go[$iend_1] + && !$this_line_is_semicolon_terminated + && $n < $nmax + && $excess + 4 > 0 + && $type_iend_2 ne ',' ); + + # do not recombine if we would skip in indentation levels + if ( $n < $nmax ) { + my $if_next = $ri_beg->[ $n + 1 ]; next - if ( $old_breakpoint_to_go[$iend_1] - && !$this_line_is_semicolon_terminated - && $n < $nmax - && $excess + 4 > 0 - && $type_iend_2 ne ',' ); - - # do not recombine if we would skip in indentation levels - if ( $n < $nmax ) { - my $if_next = $ri_beg->[ $n + 1 ]; - next - if ( - $levels_to_go[$ibeg_1] < $levels_to_go[$ibeg_2] - && $levels_to_go[$ibeg_2] < $levels_to_go[$if_next] - - # but an isolated 'if (' is undesirable - && !( - $n == 1 - && $iend_1 - $ibeg_1 <= 2 - && $type_ibeg_1 eq 'k' - && $tokens_to_go[$ibeg_1] eq 'if' - && $tokens_to_go[$iend_1] ne '(' - ) - ); - } + if ( + $levels_to_go[$ibeg_1] < $levels_to_go[$ibeg_2] + && $levels_to_go[$ibeg_2] < $levels_to_go[$if_next] + + # but an isolated 'if (' is undesirable + && !( + $n == 1 + && $iend_1 - $ibeg_1 <= 2 + && $type_ibeg_1 eq 'k' + && $tokens_to_go[$ibeg_1] eq 'if' + && $tokens_to_go[$iend_1] ne '(' + ) + ); + } - ## OLD: honor no-break's - ## next if ( $bs >= NO_BREAK - 1 ); # removed for b1257 + ## OLD: honor no-break's + ## next if ( $bs >= NO_BREAK - 1 ); # removed for b1257 - # remember the pair with the greatest bond strength - if ( !$n_best ) { + # remember the pair with the greatest bond strength + if ( !$n_best ) { + $n_best = $n; + $bs_best = $bs; + } + else { + + if ( $bs > $bs_best ) { $n_best = $n; $bs_best = $bs; } - else { - - if ( $bs > $bs_best ) { - $n_best = $n; - $bs_best = $bs; - } - } - } - - # recombine the pair with the greatest bond strength - if ($n_best) { - splice @{$ri_beg}, $n_best, 1; - splice @{$ri_end}, $n_best - 1, 1; - splice @joint, $n_best, 1; - - # keep going if we are still making progress - $more_to_do++; } - } # end iteration loop - - } # end loop over sections + } - RETURN: + # recombine the pair with the greatest bond strength + if ($n_best) { + splice @{$ri_beg}, $n_best, 1; + splice @{$ri_end}, $n_best - 1, 1; + splice @{$rjoint}, $n_best, 1; - if (DEBUG_RECOMBINE) { - my $nmax_last = @{$ri_end} - 1; - print STDERR -"exiting recombine with $nmax_last lines, starting lines=$nmax_start, iterations=$it_count, max_it=$it_count_max numsec=$num_sections\n"; - } - return; - } ## end sub recombine_breakpoints + # keep going if we are still making progress + $more_to_do++; + } + } # end iteration loop + return $it_count; + } ## end sub recombine_breakpoints_section_loop sub recombine_section_0 { my ( $itok, $ri_beg, $ri_end, $n, $rleading_amp_count ) = @_;