From fe83208bcf86c347a11f18e1624e4bf731d570b8 Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Thu, 3 Nov 2022 17:08:33 -0700 Subject: [PATCH] fix irregular -ce indentation seen in rt #144979 --- CHANGES.md | 3 + lib/Perl/Tidy/Formatter.pm | 47 +++++++-- t/snippets/expect/git09.git09 | 6 +- t/snippets/expect/git10.git10 | 6 +- t/snippets/expect/rt144979.def | 42 ++++++++ t/snippets/expect/rt144979.rt144979 | 40 +++++++ t/snippets/packing_list.txt | 2 + t/snippets/rt144979.in | 38 +++++++ t/snippets/rt144979.par | 1 + t/snippets15.t | 6 +- t/snippets16.t | 6 +- t/snippets27.t | 158 ++++++++++++++++++++++++++-- 12 files changed, 326 insertions(+), 29 deletions(-) create mode 100644 t/snippets/expect/rt144979.def create mode 100644 t/snippets/expect/rt144979.rt144979 create mode 100644 t/snippets/rt144979.in create mode 100644 t/snippets/rt144979.par diff --git a/CHANGES.md b/CHANGES.md index 13b3c31d..75adf91a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -6,6 +6,9 @@ Several minor issues have been fixed, and some new parameters have been added, as follows: + - Fixed rare problem with irregular indentation involving --cuddled-else, + usually also with the combination -xci and -lp. Reported in rt #144979. + - Add option --weld-fat-comma (-wfc) for issue git #108. When -wfc is set, along with -wn, perltidy is allowed to weld an opening paren to an inner opening container when they are separated by a hash key diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index d32e44f7..919e8c11 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -458,6 +458,8 @@ BEGIN { _rparent_of_seqno_ => $i++, _rchildren_of_seqno_ => $i++, _ris_list_by_seqno_ => $i++, + _ris_cuddled_closing_brace_ => $i++, + _ris_cuddled_opening_brace_ => $i++, _rbreak_container_ => $i++, _rshort_nested_ => $i++, _length_function_ => $i++, @@ -877,6 +879,8 @@ sub new { $self->[_rparent_of_seqno_] = {}; $self->[_rchildren_of_seqno_] = {}; $self->[_ris_list_by_seqno_] = {}; + $self->[_ris_cuddled_closing_brace_] = {}; + $self->[_ris_cuddled_opening_brace_] = {}; $self->[_rbreak_container_] = {}; # prevent one-line blocks $self->[_rshort_nested_] = {}; # blocks not forced open @@ -9100,10 +9104,12 @@ sub weld_cuddled_blocks { my $rLL = $self->[_rLL_]; return unless ( defined($rLL) && @{$rLL} ); - my $rbreak_container = $self->[_rbreak_container_]; - my $K_opening_container = $self->[_K_opening_container_]; - my $K_closing_container = $self->[_K_closing_container_]; + my $rbreak_container = $self->[_rbreak_container_]; + my $ris_cuddled_closing_brace = $self->[_ris_cuddled_closing_brace_]; + my $ris_cuddled_opening_brace = $self->[_ris_cuddled_opening_brace_]; + my $K_opening_container = $self->[_K_opening_container_]; + my $K_closing_container = $self->[_K_closing_container_]; my $is_broken_block = sub { @@ -9206,6 +9212,14 @@ sub weld_cuddled_blocks { # so that the cuddled line is balanced. $rbreak_container->{$opening_seqno} = 1 if ($CBO); + + # Remember which braces are cuddled. + # The closing brace is used to set adjusted indentations. + # The opening brace is not yet used but might eventually + # be needed in setting adjusted indentation. + $ris_cuddled_closing_brace->{$closing_seqno} = 1; + $ris_cuddled_opening_brace->{$opening_seqno} = 1; + } } @@ -25199,7 +25213,14 @@ sub get_seqno { $terminal_type = $types_to_go[ $iend - 2 ]; } } - if ( $terminal_type eq '{' ) { + + # Patch for rt144979, part 2. Coordinated with part 1. + # Skip cuddled braces. + my $seqno_beg = $type_sequence_to_go[$ibeg]; + my $is_cuddled_closing_brace = $seqno_beg + && $self->[_ris_cuddled_closing_brace_]->{$seqno_beg}; + + if ( $terminal_type eq '{' && !$is_cuddled_closing_brace ) { my $Kbeg = $K_to_go[$ibeg]; $ci_levels_to_go[$ibeg] = 0; } @@ -27082,6 +27103,13 @@ sub make_paren_name { = $self->get_opening_indentation( $ibeg_weld_fix, $ri_first, $ri_last, $rindentation_list, $seqno_qw_closing ); + # Patch for rt144979, part 1. Coordinated with part 2. + # Do not undo ci for a cuddled closing brace control; it + # needs to be treated exactly the same ci as an isolated + # closing brace. + my $is_cuddled_closing_brace = $seqno_beg + && $self->[_ris_cuddled_closing_brace_]->{$seqno_beg}; + # First set the default behavior: if ( @@ -27089,14 +27117,15 @@ sub make_paren_name { # of the form: "); }; ]; )->xxx;" $is_semicolon_terminated - # and 'cuddled parens' of the form: ")->pack(" - # Bug fix for RT #123749]: the types here were - # incorrectly '(' and ')'. Corrected to be '{' and '}' + # and 'cuddled parens' of the form: ")->pack(". Bug fix for RT + # #123749]: the TYPES here were incorrectly ')' and '('. The + # corrected TYPES are '}' and '{'. But skip a cuddled block. || ( $terminal_type eq '{' && $type_beg eq '}' && ( $nesting_depth_to_go[$iend] + 1 == $nesting_depth_to_go[$ibeg] ) + && !$is_cuddled_closing_brace ) # remove continuation indentation for any line like @@ -27108,6 +27137,9 @@ sub make_paren_name { && ( $types_to_go[$iend] eq '{' || $levels_to_go[$iend] < $level_beg ) + + # but not if a cuddled block + && !$is_cuddled_closing_brace ) # and when the next line is at a lower indentation level... @@ -27370,7 +27402,6 @@ sub make_paren_name { ); } - } ## end closure get_final_indentation sub get_opening_indentation { diff --git a/t/snippets/expect/git09.git09 b/t/snippets/expect/git09.git09 index 12813d7b..c45824c0 100644 --- a/t/snippets/expect/git09.git09 +++ b/t/snippets/expect/git09.git09 @@ -1,8 +1,8 @@ # no one-line block for first map with -ce -cbl=map,sort,grep @sorted = map { $_->[0] -} sort { + } sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] -} map { + } map { [ $_, length($_) ] -} @unsorted; + } @unsorted; diff --git a/t/snippets/expect/git10.git10 b/t/snippets/expect/git10.git10 index 6fc2108f..ee8f7ecc 100644 --- a/t/snippets/expect/git10.git10 +++ b/t/snippets/expect/git10.git10 @@ -1,8 +1,8 @@ # perltidy -wn -ce -cbl=sort,map,grep @sorted = map { $_->[0] -} sort { + } sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] -} map { + } map { [ $_, length($_) ] -} @unsorted; + } @unsorted; diff --git a/t/snippets/expect/rt144979.def b/t/snippets/expect/rt144979.def new file mode 100644 index 00000000..47b7492b --- /dev/null +++ b/t/snippets/expect/rt144979.def @@ -0,0 +1,42 @@ +# part 1 +GetOptions( + "format|f=s" => sub { + my ( $n, $v ) = @_; + if ( ( my $k = $formats{$v} ) ) { + $format = $k; + } + else { + die("--format must be 'system' or 'user'\n"); + } + return; + }, +); + +# part 2 +{ + { + { + my $desc = + $access + ? "for -$op under use filetest 'access' $desc_tail" + : "for -$op $desc_tail"; + { + local $SIG{__WARN__} = sub { + my $w = shift; + if ( $w =~ /^File::stat ignores VMS ACLs/ ) { + ++$vwarn; + } + elsif ( $w =~ /^File::stat ignores use filetest 'access'/ ) + { + ++$awarn; + } + else { + $warnings .= $w; + } + }; + $rv = eval "$access; -$op \$stat"; + } + } + } +} + diff --git a/t/snippets/expect/rt144979.rt144979 b/t/snippets/expect/rt144979.rt144979 new file mode 100644 index 00000000..017e97b8 --- /dev/null +++ b/t/snippets/expect/rt144979.rt144979 @@ -0,0 +1,40 @@ +# part 1 +GetOptions( + "format|f=s" => sub { + my ( $n, $v ) = @_; + if ( ( my $k = $formats{$v} ) ) { + $format = $k; + } else { + die("--format must be 'system' or 'user'\n"); + } + return; + }, +); + +# part 2 +{ + { + { + my $desc = + $access + ? "for -$op under use filetest 'access' $desc_tail" + : "for -$op $desc_tail"; + { + local $SIG{__WARN__} = sub { + my $w = shift; + if ( $w =~ /^File::stat ignores VMS ACLs/ ) { + ++$vwarn; + } elsif ( + $w =~ /^File::stat ignores use filetest 'access'/ ) + { + ++$awarn; + } else { + $warnings .= $w; + } + }; + $rv = eval "$access; -$op \$stat"; + } + } + } +} + diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt index 034b903a..6ca99208 100644 --- a/t/snippets/packing_list.txt +++ b/t/snippets/packing_list.txt @@ -374,6 +374,8 @@ ../snippets27.t dwic.def ../snippets27.t dwic.dwic ../snippets27.t wtc.wtc7 +../snippets27.t rt144979.def +../snippets27.t rt144979.rt144979 ../snippets3.t ce_wn1.ce_wn ../snippets3.t ce_wn1.def ../snippets3.t colin.colin diff --git a/t/snippets/rt144979.in b/t/snippets/rt144979.in new file mode 100644 index 00000000..69a3d0d6 --- /dev/null +++ b/t/snippets/rt144979.in @@ -0,0 +1,38 @@ +# part 1 +GetOptions( + "format|f=s" => sub { + my ( $n, $v ) = @_; + if ( ( my $k = $formats{$v} ) ) { + $format = $k; + } else { + die("--format must be 'system' or 'user'\n"); + } + return; + }, +); + +# part 2 +{{{ + my $desc = + $access + ? "for -$op under use filetest 'access' $desc_tail" + : "for -$op $desc_tail"; + { + local $SIG{__WARN__} = sub { + my $w = shift; + if ($w =~ /^File::stat ignores VMS ACLs/) + { + ++$vwarn; + } elsif ( + $w =~ /^File::stat ignores use filetest 'access'/) + { + ++$awarn; + } else + { + $warnings .= $w; + } + }; + $rv = eval "$access; -$op \$stat"; + } +}}} + diff --git a/t/snippets/rt144979.par b/t/snippets/rt144979.par new file mode 100644 index 00000000..c12c9790 --- /dev/null +++ b/t/snippets/rt144979.par @@ -0,0 +1 @@ +-xci -ce -lp diff --git a/t/snippets15.t b/t/snippets15.t index f79abe8d..b51c0c5f 100644 --- a/t/snippets15.t +++ b/t/snippets15.t @@ -407,11 +407,11 @@ elsif ( $i > $depth ) { $_ = 0; } # no one-line block for first map with -ce -cbl=map,sort,grep @sorted = map { $_->[0] -} sort { + } sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] -} map { + } map { [ $_, length($_) ] -} @unsorted; + } @unsorted; #14........... }, diff --git a/t/snippets16.t b/t/snippets16.t index 7322a8b5..9e8f75c0 100644 --- a/t/snippets16.t +++ b/t/snippets16.t @@ -236,11 +236,11 @@ my %Structure = $Self->PackageParse( String => $Package ); # perltidy -wn -ce -cbl=sort,map,grep @sorted = map { $_->[0] -} sort { + } sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] -} map { + } map { [ $_, length($_) ] -} @unsorted; + } @unsorted; #5........... }, diff --git a/t/snippets27.t b/t/snippets27.t index 42035891..beb1ef51 100644 --- a/t/snippets27.t +++ b/t/snippets27.t @@ -10,6 +10,8 @@ #7 dwic.def #8 dwic.dwic #9 wtc.wtc7 +#10 rt144979.def +#11 rt144979.rt144979 # To locate test #13 you can search for its name or the string '#13' @@ -27,15 +29,16 @@ BEGIN { # BEGIN SECTION 1: Parameter combinations # ########################################### $rparams = { - 'def' => "", - 'dwic' => "-wn -dwic", - 'wtc1' => "-wtc=0 -dtc", - 'wtc2' => "-wtc=1 -atc", - 'wtc3' => "-wtc=m -atc", - 'wtc4' => "-wtc=m -atc -dtc", - 'wtc5' => "-wtc=b -atc -dtc -vtc=2", - 'wtc6' => "-wtc=i -atc -dtc -vtc=2", - 'wtc7' => "-wtc=h -atc -dtc -vtc=2", + 'def' => "", + 'dwic' => "-wn -dwic", + 'rt144979' => "-xci -ce -lp", + 'wtc1' => "-wtc=0 -dtc", + 'wtc2' => "-wtc=1 -atc", + 'wtc3' => "-wtc=m -atc", + 'wtc4' => "-wtc=m -atc -dtc", + 'wtc5' => "-wtc=b -atc -dtc -vtc=2", + 'wtc6' => "-wtc=i -atc -dtc -vtc=2", + 'wtc7' => "-wtc=h -atc -dtc -vtc=2", }; ############################ @@ -52,6 +55,47 @@ BEGIN { PL_sys_intern ) ], ); +---------- + + 'rt144979' => <<'----------', +# part 1 +GetOptions( + "format|f=s" => sub { + my ( $n, $v ) = @_; + if ( ( my $k = $formats{$v} ) ) { + $format = $k; + } else { + die("--format must be 'system' or 'user'\n"); + } + return; + }, +); + +# part 2 +{{{ + my $desc = + $access + ? "for -$op under use filetest 'access' $desc_tail" + : "for -$op $desc_tail"; + { + local $SIG{__WARN__} = sub { + my $w = shift; + if ($w =~ /^File::stat ignores VMS ACLs/) + { + ++$vwarn; + } elsif ( + $w =~ /^File::stat ignores use filetest 'access'/) + { + ++$awarn; + } else + { + $warnings .= $w; + } + }; + $rv = eval "$access; -$op \$stat"; + } +}}} + ---------- 'wtc' => <<'----------', @@ -505,6 +549,102 @@ my $no_index_1_1 = #9........... }, + + 'rt144979.def' => { + source => "rt144979", + params => "def", + expect => <<'#10...........', +# part 1 +GetOptions( + "format|f=s" => sub { + my ( $n, $v ) = @_; + if ( ( my $k = $formats{$v} ) ) { + $format = $k; + } + else { + die("--format must be 'system' or 'user'\n"); + } + return; + }, +); + +# part 2 +{ + { + { + my $desc = + $access + ? "for -$op under use filetest 'access' $desc_tail" + : "for -$op $desc_tail"; + { + local $SIG{__WARN__} = sub { + my $w = shift; + if ( $w =~ /^File::stat ignores VMS ACLs/ ) { + ++$vwarn; + } + elsif ( $w =~ /^File::stat ignores use filetest 'access'/ ) + { + ++$awarn; + } + else { + $warnings .= $w; + } + }; + $rv = eval "$access; -$op \$stat"; + } + } + } +} + +#10........... + }, + + 'rt144979.rt144979' => { + source => "rt144979", + params => "rt144979", + expect => <<'#11...........', +# part 1 +GetOptions( + "format|f=s" => sub { + my ( $n, $v ) = @_; + if ( ( my $k = $formats{$v} ) ) { + $format = $k; + } else { + die("--format must be 'system' or 'user'\n"); + } + return; + }, +); + +# part 2 +{ + { + { + my $desc = + $access + ? "for -$op under use filetest 'access' $desc_tail" + : "for -$op $desc_tail"; + { + local $SIG{__WARN__} = sub { + my $w = shift; + if ( $w =~ /^File::stat ignores VMS ACLs/ ) { + ++$vwarn; + } elsif ( + $w =~ /^File::stat ignores use filetest 'access'/ ) + { + ++$awarn; + } else { + $warnings .= $w; + } + }; + $rv = eval "$access; -$op \$stat"; + } + } + } +} + +#11........... + }, }; my $ntests = 0 + keys %{$rtests}; -- 2.39.5