From e5717edd2647decb26d018097ecba6067aa44b9f Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Fri, 12 Aug 2022 16:44:12 -0700 Subject: [PATCH] fix issue git #106 --- CHANGES.md | 12 +++ lib/Perl/Tidy/Formatter.pm | 92 +++++++++++++++- lib/Perl/Tidy/IndentationItem.pm | 7 ++ t/snippets/expect/git106.def | 50 +++++++++ t/snippets/expect/git106.git106 | 43 ++++++++ t/snippets/git106.in | 50 +++++++++ t/snippets/git106.par | 1 + t/snippets/packing_list.txt | 4 +- t/snippets26.t | 173 ++++++++++++++++++++++++++++++- 9 files changed, 425 insertions(+), 7 deletions(-) create mode 100644 t/snippets/expect/git106.def create mode 100644 t/snippets/expect/git106.git106 create mode 100644 t/snippets/git106.in create mode 100644 t/snippets/git106.par diff --git a/CHANGES.md b/CHANGES.md index 212e712e..ebdf7b86 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,18 @@ ## 2022 06 13.03 + - Fix issue git #106. This fixes some edge cases of formatting with the + combination -xlp -pt=2, mainly for two-line lists with short function + names. One indentation space is removed to improve alignment: + + # OLD: perltidy -xlp -pt=2 + is($module->VERSION, $expected, + "$main_module->VERSION matches $module->VERSION ($expected)"); + + # NEW: perltidy -xlp -pt=2 + is($module->VERSION, $expected, + "$main_module->VERSION matches $module->VERSION ($expected)"); + - Fix for issue git #105, incorrect formatting with 5.36 experimental for_list feature. diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index 5fcafd05..faa0b9af 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -21982,6 +21982,7 @@ EOM # it becomes clear that we do not have a good list. my $available_spaces = 0; my $align_seqno = 0; + my $K_extra_space; my $last_nonblank_seqno; my $last_nonblank_block_type; @@ -22089,8 +22090,35 @@ EOM } elsif ( $available_spaces > 1 ) { $min_gnu_indentation += $available_spaces + 1; + + # The "+1" space can cause mis-alignment if there is no + # blank space between the opening paren and the next + # nonblank token (i.e., -pt=2) and the container does not + # get broken open. So we will mark this token for later + # space removal by sub 'xlp_tweak' if this container + # remains intact (issue git #106). + if ( + $type ne 'b' + + # Skip if the maximum line length is exceeded here + && $excess <= 0 + + # This is only for level changes, not ci level changes. + # But note: this test is here out of caution but I have + # not found a case where it is actually necessary. + && $is_opening_token{$last_nonblank_token} + + # Be sure we are at consecutive nonblanks. This test + # should be true, but it guards against future coding + # changes to level values assigned to blank spaces. + && $ii > 0 + && $types_to_go[ $ii - 1 ] ne 'b' + + ) + { + $K_extra_space = $K_to_go[$ii]; + } } - ##elsif ( $last_nonblank_token =~ /^[\{\[\(]$/ ) { elsif ( $is_opening_token{$last_nonblank_token} ) { if ( ( $tightness{$last_nonblank_token} < 2 ) ) { $min_gnu_indentation += 2; @@ -22165,6 +22193,7 @@ EOM stack_depth => $max_lp_stack, K_begin_line => $K_begin_line, standard_spaces => $standard_spaces, + K_extra_space => $K_extra_space, ); DEBUG_LP && do { @@ -22563,6 +22592,9 @@ sub convey_batch_to_vertical_aligner { $starting_in_quote ) if ( $n_last_line > 0 && $rOpts_logical_padding ); + $self->xlp_tweak( $ri_first, $ri_last ) + if ( $rOpts_extended_line_up_parentheses && $n_last_line > 0 ); + if (DEVEL_MODE) { $self->check_batch_summed_lengths() } # ---------------------------------------------------------- @@ -24350,6 +24382,64 @@ sub pad_token { return; } ## end sub pad_token +sub xlp_tweak { + + # Remove one indentation space from unbroken containers marked with + # 'K_extra_space'. These are mostly two-line lists with short names + # formatted with -xlp -pt=2. + # + # Before this fix (extra space in line 2): + # is($module->VERSION, $expected, + # "$main_module->VERSION matches $module->VERSION ($expected)"); + # + # After this fix: + # is($module->VERSION, $expected, + # "$main_module->VERSION matches $module->VERSION ($expected)"); + # + # Notes: + # - This fixes issue git #106 + # - This must be called after 'set_logical_padding'. + # - This is currently only applied to -xlp. It would also work for -lp + # but that style is essentially frozen. + + my ( $self, $ri_first, $ri_last ) = @_; + + # Must be 2 or more lines + return unless ( @{$ri_first} > 1 ); + + # Pull indentation object from start of second line + my $ibeg_1 = $ri_first->[1]; + my $lp_object = $leading_spaces_to_go[$ibeg_1]; + return if ( !ref($lp_object) ); + + # This only applies to an indentation object with a marked token + my $K_extra_space = $lp_object->get_K_extra_space(); + return unless ($K_extra_space); + + # Look for the marked token within the first line of this batch + my $ibeg_0 = $ri_first->[0]; + my $iend_0 = $ri_last->[0]; + my $ii = $ibeg_0 + $K_extra_space - $K_to_go[$ibeg_0]; + return if ( $ii <= $ibeg_0 || $ii > $iend_0 ); + + # Skip padded tokens, they have already been aligned + my $tok = $tokens_to_go[$ii]; + return if ( substr( $tok, 0, 1 ) eq SPACE ); + + # Skip 'if'-like statements, this does not improve them + return + if ( $types_to_go[$ibeg_0] eq 'k' + && $is_if_unless_elsif{ $tokens_to_go[$ibeg_0] } ); + + # Looks okay, reduce indentation by 1 space if possible + my $spaces = $lp_object->get_spaces(); + if ( $spaces > 0 ) { + $lp_object->decrease_SPACES(1); + } + + return; +} + { ## begin closure make_alignment_patterns my %keyword_map; diff --git a/lib/Perl/Tidy/IndentationItem.pm b/lib/Perl/Tidy/IndentationItem.pm index 87949cd6..a3bb4022 100644 --- a/lib/Perl/Tidy/IndentationItem.pm +++ b/lib/Perl/Tidy/IndentationItem.pm @@ -31,6 +31,7 @@ BEGIN { _K_begin_line_ => $i++, _arrow_count_ => $i++, _standard_spaces_ => $i++, + _K_extra_space_ => $i++, }; } @@ -102,6 +103,7 @@ sub new { $self->[_K_begin_line_] = $input_hash{K_begin_line}; $self->[_arrow_count_] = 0; $self->[_standard_spaces_] = $input_hash{standard_spaces}; + $self->[_K_extra_space_] = $input_hash{K_extra_space}; bless $self, $class; return $self; @@ -187,6 +189,7 @@ sub decrease_SPACES { sub decrease_available_spaces { my ( $self, $value ) = @_; + if ( defined($value) ) { $self->[_available_spaces_] -= $value; } @@ -238,6 +241,10 @@ sub get_K_begin_line { return $_[0]->[_K_begin_line_]; } +sub get_K_extra_space { + return $_[0]->[_K_extra_space_]; +} + sub set_have_child { my ( $self, $value ) = @_; if ( defined($value) ) { diff --git a/t/snippets/expect/git106.def b/t/snippets/expect/git106.def new file mode 100644 index 00000000..e288494a --- /dev/null +++ b/t/snippets/expect/git106.def @@ -0,0 +1,50 @@ +is( $module->VERSION, $expected, + "$main_module->VERSION matches $module->VERSION ($expected)" ); + +ok( ( $@ eq "" && "@b" eq "1 4 5 9" ), + 'redefinition should not take effect during the sort' ); + +&$f( + ( map { $points->slice($_) } @sls1 ), + ( map { $n->slice($_) } @sls1 ), + ( map { $this->{Colors}->slice($_) } @sls1 ) +); + +AA( + "0123456789012345678901234567890123456789", + "0123456789012345678901234567890123456789" +); + +AAAAAA( + "0123456789012345678901234567890123456789", + "0123456789012345678901234567890123456789" +); + +# padded +return !( $elem->isa('PPI::Statement::End') + || $elem->isa('PPI::Statement::Data') ); + +for ( + $s = $dbobj->seq( $k, $v, R_LAST ) ; + $s == 0 ; + $s = $dbobj->seq( $k, $v, R_PREV ) + ) +{ + print "$k: $v\n"; +} + +# excess without -xci +fresh_perl_is( '-C-', + <<'abcdefghijklmnopq', {}, "ambiguous unary operator check doesn't crash" ); +Warning: Use of "-C-" without parentheses is ambiguous at - line 1. +abcdefghijklmnopq + +# excess with -xci +{ + { + { + $self->privmsg( $to, + "One moment please, I shall display the groups with agendas:" ); + } + } +} diff --git a/t/snippets/expect/git106.git106 b/t/snippets/expect/git106.git106 new file mode 100644 index 00000000..ac0f6084 --- /dev/null +++ b/t/snippets/expect/git106.git106 @@ -0,0 +1,43 @@ +is($module->VERSION, $expected, + "$main_module->VERSION matches $module->VERSION ($expected)"); + +ok(($@ eq "" && "@b" eq "1 4 5 9"), + 'redefinition should not take effect during the sort'); + +&$f((map { $points->slice($_) } @sls1), + (map { $n->slice($_) } @sls1), + (map { $this->{Colors}->slice($_) } @sls1)); + +AA("0123456789012345678901234567890123456789", + "0123456789012345678901234567890123456789"); + +AAAAAA("0123456789012345678901234567890123456789", + "0123456789012345678901234567890123456789"); + +# padded +return !( $elem->isa('PPI::Statement::End') + || $elem->isa('PPI::Statement::Data')); + +for ($s = $dbobj->seq($k, $v, R_LAST) ; + $s == 0 ; + $s = $dbobj->seq($k, $v, R_PREV)) +{ + print "$k: $v\n"; +} + +# excess without -xci +fresh_perl_is('-C-', + <<'abcdefghijklmnopq', {}, "ambiguous unary operator check doesn't crash"); +Warning: Use of "-C-" without parentheses is ambiguous at - line 1. +abcdefghijklmnopq + +# excess with -xci +{ + { + { + $self->privmsg($to, + "One moment please, I shall display the groups with agendas:" + ); + } + } +} diff --git a/t/snippets/git106.in b/t/snippets/git106.in new file mode 100644 index 00000000..e288494a --- /dev/null +++ b/t/snippets/git106.in @@ -0,0 +1,50 @@ +is( $module->VERSION, $expected, + "$main_module->VERSION matches $module->VERSION ($expected)" ); + +ok( ( $@ eq "" && "@b" eq "1 4 5 9" ), + 'redefinition should not take effect during the sort' ); + +&$f( + ( map { $points->slice($_) } @sls1 ), + ( map { $n->slice($_) } @sls1 ), + ( map { $this->{Colors}->slice($_) } @sls1 ) +); + +AA( + "0123456789012345678901234567890123456789", + "0123456789012345678901234567890123456789" +); + +AAAAAA( + "0123456789012345678901234567890123456789", + "0123456789012345678901234567890123456789" +); + +# padded +return !( $elem->isa('PPI::Statement::End') + || $elem->isa('PPI::Statement::Data') ); + +for ( + $s = $dbobj->seq( $k, $v, R_LAST ) ; + $s == 0 ; + $s = $dbobj->seq( $k, $v, R_PREV ) + ) +{ + print "$k: $v\n"; +} + +# excess without -xci +fresh_perl_is( '-C-', + <<'abcdefghijklmnopq', {}, "ambiguous unary operator check doesn't crash" ); +Warning: Use of "-C-" without parentheses is ambiguous at - line 1. +abcdefghijklmnopq + +# excess with -xci +{ + { + { + $self->privmsg( $to, + "One moment please, I shall display the groups with agendas:" ); + } + } +} diff --git a/t/snippets/git106.par b/t/snippets/git106.par new file mode 100644 index 00000000..a4468e00 --- /dev/null +++ b/t/snippets/git106.par @@ -0,0 +1 @@ +-xlp -gnu -xci diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt index 20b4fb08..17cc5a2c 100644 --- a/t/snippets/packing_list.txt +++ b/t/snippets/packing_list.txt @@ -356,6 +356,7 @@ ../snippets26.t c139.def ../snippets26.t drc.def ../snippets26.t drc.drc +../snippets26.t git105.def ../snippets3.t ce_wn1.ce_wn ../snippets3.t ce_wn1.def ../snippets3.t colin.colin @@ -496,4 +497,5 @@ ../snippets9.t rt98902.def ../snippets9.t rt98902.rt98902 ../snippets9.t rt99961.def -../snippets26.t git105.def +../snippets26.t git106.def +../snippets26.t git106.git106 diff --git a/t/snippets26.t b/t/snippets26.t index 18483a3b..ea51de6a 100644 --- a/t/snippets26.t +++ b/t/snippets26.t @@ -12,6 +12,8 @@ #9 drc.def #10 drc.drc #11 git105.def +#12 git106.def +#13 git106.git106 # To locate test #13 you can search for its name or the string '#13' @@ -29,11 +31,12 @@ BEGIN { # BEGIN SECTION 1: Parameter combinations # ########################################### $rparams = { - 'bal2' => "-bal=2", - 'c133' => "-boc", - 'def' => "", - 'drc' => "-drc", - 'git93' => <<'----------', + 'bal2' => "-bal=2", + 'c133' => "-boc", + 'def' => "", + 'drc' => "-drc", + 'git106' => "-xlp -gnu -xci", + 'git93' => <<'----------', -vxl='q' ---------- 'lpxl6' => <<'----------', @@ -115,6 +118,59 @@ for my ( $k, $v ) ( 1, 2, 3, 4 ) { } say 'end'; +---------- + + 'git106' => <<'----------', +is( $module->VERSION, $expected, + "$main_module->VERSION matches $module->VERSION ($expected)" ); + +ok( ( $@ eq "" && "@b" eq "1 4 5 9" ), + 'redefinition should not take effect during the sort' ); + +&$f( + ( map { $points->slice($_) } @sls1 ), + ( map { $n->slice($_) } @sls1 ), + ( map { $this->{Colors}->slice($_) } @sls1 ) +); + +AA( + "0123456789012345678901234567890123456789", + "0123456789012345678901234567890123456789" +); + +AAAAAA( + "0123456789012345678901234567890123456789", + "0123456789012345678901234567890123456789" +); + +# padded +return !( $elem->isa('PPI::Statement::End') + || $elem->isa('PPI::Statement::Data') ); + +for ( + $s = $dbobj->seq( $k, $v, R_LAST ) ; + $s == 0 ; + $s = $dbobj->seq( $k, $v, R_PREV ) + ) +{ + print "$k: $v\n"; +} + +# excess without -xci +fresh_perl_is( '-C-', + <<'abcdefghijklmnopq', {}, "ambiguous unary operator check doesn't crash" ); +Warning: Use of "-C-" without parentheses is ambiguous at - line 1. +abcdefghijklmnopq + +# excess with -xci +{ + { + { + $self->privmsg( $to, + "One moment please, I shall display the groups with agendas:" ); + } + } +} ---------- 'git93' => <<'----------', @@ -457,6 +513,113 @@ say 'end'; #11........... }, + + 'git106.def' => { + source => "git106", + params => "def", + expect => <<'#12...........', +is( $module->VERSION, $expected, + "$main_module->VERSION matches $module->VERSION ($expected)" ); + +ok( ( $@ eq "" && "@b" eq "1 4 5 9" ), + 'redefinition should not take effect during the sort' ); + +&$f( + ( map { $points->slice($_) } @sls1 ), + ( map { $n->slice($_) } @sls1 ), + ( map { $this->{Colors}->slice($_) } @sls1 ) +); + +AA( + "0123456789012345678901234567890123456789", + "0123456789012345678901234567890123456789" +); + +AAAAAA( + "0123456789012345678901234567890123456789", + "0123456789012345678901234567890123456789" +); + +# padded +return !( $elem->isa('PPI::Statement::End') + || $elem->isa('PPI::Statement::Data') ); + +for ( + $s = $dbobj->seq( $k, $v, R_LAST ) ; + $s == 0 ; + $s = $dbobj->seq( $k, $v, R_PREV ) + ) +{ + print "$k: $v\n"; +} + +# excess without -xci +fresh_perl_is( '-C-', + <<'abcdefghijklmnopq', {}, "ambiguous unary operator check doesn't crash" ); +Warning: Use of "-C-" without parentheses is ambiguous at - line 1. +abcdefghijklmnopq + +# excess with -xci +{ + { + { + $self->privmsg( $to, + "One moment please, I shall display the groups with agendas:" ); + } + } +} +#12........... + }, + + 'git106.git106' => { + source => "git106", + params => "git106", + expect => <<'#13...........', +is($module->VERSION, $expected, + "$main_module->VERSION matches $module->VERSION ($expected)"); + +ok(($@ eq "" && "@b" eq "1 4 5 9"), + 'redefinition should not take effect during the sort'); + +&$f((map { $points->slice($_) } @sls1), + (map { $n->slice($_) } @sls1), + (map { $this->{Colors}->slice($_) } @sls1)); + +AA("0123456789012345678901234567890123456789", + "0123456789012345678901234567890123456789"); + +AAAAAA("0123456789012345678901234567890123456789", + "0123456789012345678901234567890123456789"); + +# padded +return !( $elem->isa('PPI::Statement::End') + || $elem->isa('PPI::Statement::Data')); + +for ($s = $dbobj->seq($k, $v, R_LAST) ; + $s == 0 ; + $s = $dbobj->seq($k, $v, R_PREV)) +{ + print "$k: $v\n"; +} + +# excess without -xci +fresh_perl_is('-C-', + <<'abcdefghijklmnopq', {}, "ambiguous unary operator check doesn't crash"); +Warning: Use of "-C-" without parentheses is ambiguous at - line 1. +abcdefghijklmnopq + +# excess with -xci +{ + { + { + $self->privmsg($to, + "One moment please, I shall display the groups with agendas:" + ); + } + } +} +#13........... + }, }; my $ntests = 0 + keys %{$rtests}; -- 2.39.5