From: Steve Hancock Date: Thu, 8 Dec 2022 16:20:12 +0000 (-0800) Subject: make check_to_break a named sub X-Git-Tag: 20221112.02~19 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=99b090f99e203759a64745f41a1d453b7844b6b1;p=perltidy.git make check_to_break a named sub --- diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index 35086897..26ac107d 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -5958,15 +5958,15 @@ sub find_level_info { my %level_info; my $err; - TREE_LOOP: + # TREE_LOOP: foreach my $sseq ( @{$rSS} ) { my $stack_depth = @stack; my $seq_next = $sseq > 0 ? $sseq : -$sseq; - next TREE_LOOP if ( !$rblock_type_of_seqno->{$seq_next} ); + next if ( !$rblock_type_of_seqno->{$seq_next} ); if ( $sseq > 0 ) { - STACK_LOOP: + # STACK_LOOP: foreach my $seq (@stack) { my ( $starting_depth, $maximum_depth, $total_depth_gain ) = @{ $level_info{$seq} }; @@ -5976,23 +5976,25 @@ sub find_level_info { $total_depth_gain++; $level_info{$seq} = [ $starting_depth, $maximum_depth, $total_depth_gain ]; - } + } ## end STACK LOOP push @stack, $seq_next; $level_info{$seq_next} = [ $stack_depth, $stack_depth, 1 ]; } else { my $seq_test = pop @stack; + + # error check if ( $seq_test != $seq_next ) { # Shouldn't happen - the $rSS array must have an error DEVEL_MODE && Fault("stack error finding total depths\n"); %level_info = (); - last TREE_LOOP; + last; } } - } + } ## end TREE_LOOP return \%level_info; } ## end sub find_level_info @@ -9258,6 +9260,68 @@ EOM return ( $severe_error, $rqw_lines ); } ## end sub resync_lines_and_tokens +sub check_for_break { + my ( $self, $KK, $rkeep_break_hash, $rbreak_hash ) = @_; + + # This sub is called to help implement flags: + # --keep-old-breakpoints-before and --keep-old-breakpoints-after + # Given: + # $KK = index of a token, + # $rkeep_break_hash = user control for --keep-old-... + # $rbreak_hash = hash of tokens where breaks are requested + # Set $rbreak_hash as follows if a user break is requested: + # = 1 make a hard break (flush the current batch) + # best for something like leading commas (-kbb=',') + # = 2 make a soft break (keep building current batch) + # best for something like leading -> + + my $rLL = $self->[_rLL_]; + + my $seqno = $rLL->[$KK]->[_TYPE_SEQUENCE_]; + + # non-container tokens use the type as the key + if ( !$seqno ) { + my $type = $rLL->[$KK]->[_TYPE_]; + if ( $rkeep_break_hash->{$type} ) { + $rbreak_hash->{$KK} = $is_soft_keep_break_type{$type} ? 2 : 1; + } + } + + # container tokens use the token as the key + else { + my $token = $rLL->[$KK]->[_TOKEN_]; + my $flag = $rkeep_break_hash->{$token}; + if ($flag) { + + my $match = $flag eq '1' || $flag eq '*'; + + # check for special matching codes + if ( !$match ) { + if ( $token eq '(' || $token eq ')' ) { + $match = $self->match_paren_control_flag( $seqno, $flag ); + } + elsif ( $token eq '{' || $token eq '}' ) { + + # These tentative codes 'b' and 'B' for brace types are + # placeholders for possible future brace types. They + # are not documented and may be changed. + my $block_type = $self->[_rblock_type_of_seqno_]->{$seqno}; + if ( $flag eq 'b' ) { $match = $block_type } + elsif ( $flag eq 'B' ) { $match = !$block_type } + else { + # unknown code - no match + } + } + } + if ($match) { + my $type = $rLL->[$KK]->[_TYPE_]; + $rbreak_hash->{$KK} = $is_soft_keep_break_type{$type} ? 2 : 1; + } + } + } + return; +} + sub keep_old_line_breaks { # Called once per file to find and mark any old line breaks which @@ -9282,6 +9346,10 @@ sub keep_old_line_breaks { my $ris_broken_container = $self->[_ris_broken_container_]; my $ris_list_by_seqno = $self->[_ris_list_by_seqno_]; + #---------------------------------------- + # Apply --break-at-old-method-breakpoints + #---------------------------------------- + # This code moved here from sub break_lists to fix b1120 if ( $rOpts->{'break-at-old-method-breakpoints'} ) { foreach my $item ( @{$rKrange_code_without_comments} ) { @@ -9323,65 +9391,18 @@ sub keep_old_line_breaks { } } - return unless ( %keep_break_before_type || %keep_break_after_type ); - - my $check_for_break = sub { - my ( $KK, $rkeep_break_hash, $rbreak_hash ) = @_; - my $seqno = $rLL->[$KK]->[_TYPE_SEQUENCE_]; - - # non-container tokens use the type as the key - if ( !$seqno ) { - my $type = $rLL->[$KK]->[_TYPE_]; - if ( $rkeep_break_hash->{$type} ) { - $rbreak_hash->{$KK} = $is_soft_keep_break_type{$type} ? 2 : 1; - } - } - - # container tokens use the token as the key - else { - my $token = $rLL->[$KK]->[_TOKEN_]; - my $flag = $rkeep_break_hash->{$token}; - if ($flag) { - - my $match = $flag eq '1' || $flag eq '*'; + #--------------------------------------------------------------------- + # Apply --keep-old-breakpoints-before and --keep-old-breakpoints-after + #--------------------------------------------------------------------- - # check for special matching codes - if ( !$match ) { - if ( $token eq '(' || $token eq ')' ) { - $match = - $self->match_paren_control_flag( $seqno, $flag ); - } - elsif ( $token eq '{' || $token eq '}' ) { - - # These tentative codes 'b' and 'B' for brace types are - # placeholders for possible future brace types. They - # are not documented and may be changed. - my $block_type = - $self->[_rblock_type_of_seqno_]->{$seqno}; - if ( $flag eq 'b' ) { $match = $block_type } - elsif ( $flag eq 'B' ) { $match = !$block_type } - else { - # unknown code - no match - } - } - } - if ($match) { - my $type = $rLL->[$KK]->[_TYPE_]; - $rbreak_hash->{$KK} = - $is_soft_keep_break_type{$type} ? 2 : 1; - } - } - } - }; + return unless ( %keep_break_before_type || %keep_break_after_type ); foreach my $item ( @{$rKrange_code_without_comments} ) { my ( $Kfirst, $Klast ) = @{$item}; - $check_for_break->( - $Kfirst, \%keep_break_before_type, $rbreak_before_Kfirst - ); - $check_for_break->( - $Klast, \%keep_break_after_type, $rbreak_after_Klast - ); + $self->check_for_break( $Kfirst, \%keep_break_before_type, + $rbreak_before_Kfirst ); + $self->check_for_break( $Klast, \%keep_break_after_type, + $rbreak_after_Klast ); } return; } ## end sub keep_old_line_breaks