From: Steve Hancock Date: Mon, 26 Sep 2022 13:35:55 +0000 (-0700) Subject: fix issue b1376 X-Git-Tag: 20220613.06~21 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=b291709af3090cd44437b6676d4b3a08baf3e27e;p=perltidy.git fix issue b1376 --- diff --git a/.perlcriticrc b/.perlcriticrc index 09ae203d..8958c37a 100644 --- a/.perlcriticrc +++ b/.perlcriticrc @@ -74,11 +74,16 @@ short_subroutine_statements = 2 # This is very useful, so we have to skip this. [-ClassHierarchies::ProhibitAutoloading] -# The max values below can be reduced to locate code which might be simplified. +# This policy is very useful in locating complex code which might benefit from +# simplification. The max value has to be set rather high here because there +# are some routines in Formatter.pm with high mccabe values. [Subroutines::ProhibitExcessComplexity] -max_mccabe=120 -[ControlStructures::ProhibitDeepNests] -max_nests=7 +max_mccabe=125 + +# This policy can be very helpful for locating complex code, but there are too +# many good exceptions to use it as a general rule. So it is turned off here. +[-ControlStructures::ProhibitDeepNests] +# max_nests=8 # The if-elsif sequences in perltidy have all been profiled and # are fine as is. Changing them would complicate the code without diff --git a/dev-bin/run_convergence_tests.pl.data b/dev-bin/run_convergence_tests.pl.data index 69e5d505..29ceacdc 100644 --- a/dev-bin/run_convergence_tests.pl.data +++ b/dev-bin/run_convergence_tests.pl.data @@ -10162,6 +10162,24 @@ $font_size --opening-square-bracket-right --variable-maximum-line-length +==> b1376.in <== +# S1 + unless ( opendir ( + CATDIR, $catdir ) ) +# S2 + unless ( opendir ( + CATDIR, $catdir + ) ) + + +==> b1376.par <== +--add-trailing-commas='b' +--extended-line-up-parentheses +--indent-columns=6 +--maximum-line-length=47 +--space-keyword-paren +--weld-nested-containers + ==> b140.in <== $cmd[ $i ]=[ $s, $e, $cmd, \@hunk, $i ] ; diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index 88db6209..5fb854ff 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -794,7 +794,7 @@ sub new { file_writer_object => $file_writer_object, logger_object => $logger_object, diagnostics_object => $diagnostics_object, - length_function => $length_function + length_function => $length_function, ); write_logfile_entry("\nStarting tokenization pass...\n"); @@ -2447,10 +2447,14 @@ sub initialize_trailing_comma_rules { my $atc = $add_trailing_comma_rules{$key}; my $dtc = $delete_trailing_comma_rules{$key}; if ( $atc && $dtc ) { - if ( $atc eq 'm' || $atc eq '*' || $dtc eq '*' ) { + + # The easiest way to insure that instabilities occur would be to + # allow just one of -atc and -dtc for each container type. But for + # now we allow a few combinations that should be independent. + if ( $dtc eq '*' || $atc ne 'h' ) { if ( !DEVEL_MODE ) { Warn(<K_previous_nonblank( undef, $rLL_new ); + return unless ( defined($Kp) ); + my $type_p = $rLL_new->[$Kp]->[_TYPE_]; + return if ( $type_p eq '#' ); + # List of user control flag values: # -atc='' or '0' does not add any new commas [DEFAULT] # -atc='h' add a bare trailing comma to a stable list with about one @@ -7748,12 +7760,7 @@ sub add_trailing_comma { # We will set a flag to allow deletion by 'delete_tokens' # during output as follows: - # Possible deletion will be done during output by 'delete_tokens' using: - # $OK_control_flag = - # c - delete if still covered in output stream - # s - delete if still single line in output stream - # '-' - do not place in the deletion list - my $OK_control_flag; + my $OK_to_add; #----------------------------------------------------------------- # -atc='h' add a bare trailing comma to a stable list with about one @@ -7792,12 +7799,25 @@ sub add_trailing_comma { # but to provide mercy for a list to have one item without a fat comma, # we can use: # $rtype_count->{'=>'} >= $required_comma_count - if ( $required_comma_count >= $min_comma_count - && $rtype_count->{'=>'} - && $rtype_count->{'=>'} >= $required_comma_count - && ( !$rOpts_ignore_old_breakpoints || $is_permanently_broken ) ) + my $fat_comma_count = $rtype_count->{'=>'}; + $fat_comma_count = 0 unless defined($fat_comma_count); + if ( + $required_comma_count >= $min_comma_count + + && ( + + # always ok: + $fat_comma_count == $required_comma_count + 1 + + # ok with 2 or more fat commas: + || ( $fat_comma_count >= $required_comma_count + && $fat_comma_count > 1 ) + ) + + && ( !$rOpts_ignore_old_breakpoints || $is_permanently_broken ) + ) { - $OK_control_flag = 'c'; + $OK_to_add = 1; } # Next check for a simple list of items stabilized by blank lines, @@ -7808,7 +7828,7 @@ sub add_trailing_comma { || $rOpts_break_at_old_comma_breakpoints ) ) { - $OK_control_flag = 'c'; + $OK_to_add = 1; } } @@ -7817,7 +7837,7 @@ sub add_trailing_comma { #--------------------------------------------- elsif ( $add_option eq 'b' ) { if ($is_bare_comma) { - $OK_control_flag = 'c'; + $OK_to_add = 1; } } @@ -7827,7 +7847,7 @@ sub add_trailing_comma { #--------------------------------------------------------------------- elsif ( $add_option eq 'm' ) { if ($is_multiline) { - $OK_control_flag = 's'; + $OK_to_add = 1; } } @@ -7835,7 +7855,7 @@ sub add_trailing_comma { # -atc='*' add a trailing comma (bare or covered) to any list #---------------------------------------------------------- elsif ( $add_option eq '*' ) { - $OK_control_flag = '-'; + $OK_to_add = 1; } # unrecognized parameter, should have been caught in input check @@ -7843,27 +7863,13 @@ sub add_trailing_comma { } - return unless ($OK_control_flag); - - #------------------------------------------------ - # Do not add a comma if it would follow a comment - #------------------------------------------------ - my $Kp = $self->K_previous_nonblank( undef, $rLL_new ); - return unless ( defined($Kp) ); - my $type_p = $rLL_new->[$Kp]->[_TYPE_]; - return if ( $type_p eq '#' ); + return unless ($OK_to_add); #------------------- # OK: add a ',' here #------------------- my $Knew = $self->store_new_token( ',', ',', $Kp ); - # Add this token to the deletion list to later undo it if the conditions - # are not also met when it is in the output stream - if ( $OK_control_flag ne '-' ) { - push @{ $self->[_rK_deletion_list_list_] }, [ $Knew, $OK_control_flag ]; - } - return; } ## end sub add_trailing_comma @@ -7905,10 +7911,7 @@ sub delete_trailing_comma { my $token_p = $rLL_new->[$Kp]->[_TOKEN_]; if ( $token_p ne ',' ) { - # shouldn't happen if caller checked that last_nonblank_code_type eq ',' - DEVEL_MODE && Fault(<get_closing_token_indentation(