From 71590c6d68def8c4802a8a202749f7417825f160 Mon Sep 17 00:00:00 2001
From: Steve Hancock <perltidy@users.sourceforge.net>
Date: Fri, 28 Oct 2022 06:02:42 -0700
Subject: [PATCH] revise -wtc=h and i to fix b1401 b1403 b1404
---
CHANGES.md | 14 ++-
bin/perltidy | 12 +--
dev-bin/perltidy_random_setup.pl | 2 +-
dev-bin/run_convergence_tests.pl.data | 73 +++++++++++++++
lib/Perl/Tidy/Formatter.pm | 130 ++++++++------------------
t/snippets/expect/wtc.def | 4 +-
t/snippets/expect/wtc.wtc1 | 2 +-
t/snippets/expect/wtc.wtc2 | 2 +-
t/snippets/expect/wtc.wtc3 | 2 +-
t/snippets/expect/wtc.wtc4 | 2 +-
t/snippets/expect/wtc.wtc5 | 2 +-
t/snippets/expect/wtc.wtc6 | 5 +-
t/snippets/expect/wtc.wtc7 | 5 +-
t/snippets/packing_list.txt | 2 +-
t/snippets/wtc.in | 4 +-
t/snippets26.t | 8 +-
t/snippets27.t | 24 ++---
17 files changed, 161 insertions(+), 132 deletions(-)
diff --git a/CHANGES.md b/CHANGES.md
index 8259699b..13b3c31d 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -2,6 +2,10 @@
## 2022 06 13.06
+ - No significant bugs have been found since the last release to CPAN.
+ Several minor issues have been fixed, and some new parameters have been
+ added, as follows:
+
- 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
@@ -103,17 +107,19 @@
$j -= $shell
)
+ This will change some existing formatting.
+
- The following new parameters are available for manipulating
- trailing commas:
+ trailing commas. They are described in the manual.
--want-trailing-commas=s, -wtc=s
--add-trailing-commas, -atc
--delete-trailing-commas, -dtc
--delete-weld-interfering-commas, -dwic
- - This version runs about 10 to 15 percent faster than the previous
- release on large files, depending on formatting parameters, due to
- optimizations made with the help of Devel::NYTProf.
+ - This version runs 10 to 15 percent faster than the previous
+ release on large files due to optimizations made with the help of
+ Devel::NYTProf.
## 2022 06 13
diff --git a/bin/perltidy b/bin/perltidy
index 8c44f641..0d6ac057 100755
--- a/bin/perltidy
+++ b/bin/perltidy
@@ -3623,27 +3623,25 @@ a container of items (parens, square brackets, or braces), which is not a code
block, with one or more commas. These parameters only apply to something that
fits this definition of a list.
-So a paren-less list of parameters is not a list by this definition, so these parameters have no effect on a peren-less list. For example, the trailing comma
-in the following line cannot be manipulated with these parameters:
-
- my $theta = atan2 $y, $x, ;
+Note that a paren-less list of parameters is not a list by this definition, so
+these parameters have no effect on a peren-less list.
Another consequence is that if the only comma in a list is deleted, then it
cannot later be added back with these parameters because the container no
longer fits this definition of a list. For example, given
- $x = $r * cos( $theta, );
+ my ( $self, ) = @_;
and if we remove the comma with
# perltidy -wtc=m -dtc
- $x = $r * cos( $theta );
+ my ( $self ) = @_;
then we cannot use these trailing comma controls to add this comma back.
=item *
-By B<multiline> list is meant a list for which the opening and closing tokens
+By B<multiline> list is meant a list for which the first comma and trailing comma
are on different lines.
=item *
diff --git a/dev-bin/perltidy_random_setup.pl b/dev-bin/perltidy_random_setup.pl
index 0e8e8ad4..5f2c6103 100755
--- a/dev-bin/perltidy_random_setup.pl
+++ b/dev-bin/perltidy_random_setup.pl
@@ -1135,7 +1135,7 @@ EOM
'space-prototype-paren' => [ 0, 2 ],
'break-after-labels' => [ 0, 2 ],
- 'want-trailing-commas' => [ '0', '*', 'm', 'b', 'h', ' ' ],
+ 'want-trailing-commas' => [ '0', '*', 'm', 'b', 'h', 'i', ' ' ],
# Arbitrary limits to keep things readable
'blank-lines-after-opening-block' => [ 0, 4 ],
diff --git a/dev-bin/run_convergence_tests.pl.data b/dev-bin/run_convergence_tests.pl.data
index 765e0d3e..6f59edbd 100644
--- a/dev-bin/run_convergence_tests.pl.data
+++ b/dev-bin/run_convergence_tests.pl.data
@@ -10540,6 +10540,79 @@ $cmd[ $i ]=
--nowant-right-space='=~ >>= ||= %= >>= - | /= //= + - |= !~ <= = ||= =~'
--variable-maximum-line-length
+==> b1401.in <==
+ my $moon_variation =
+ 0.6583 *
+ sin(
+ torad(
+ 2 * (
+ $moon_corrected_longitude
+ - $sun_lambda
+ ) ) );
+
+ my $moon_variation =
+ 0.6583 * sin( torad(
+ 2 * (
+ $moon_corrected_longitude
+ - $sun_lambda
+ )
+ ) );
+
+
+==> b1401.par <==
+--continuation-indentation=7
+--extended-line-up-parentheses
+--maximum-line-length=32
+--weld-nested-containers
+
+==> b1403.in <==
+ $template->param(
+ index => $index,
+ index2 => $index2,
+ "f1_$result" => "f1_"
+ . $result,
+ );
+
+ $template->param(
+ index => $index,
+ index2 => $index2,
+ "f1_$result" => "f1_" . $result
+ );
+
+==> b1403.par <==
+--add-trailing-commas
+--delete-trailing-commas
+--indent-columns=1
+--keep-old-breakpoints-before=')'
+--maximum-line-length=33
+--want-trailing-commas='h'
+
+==> b1404.in <==
+my %MyTokens= (
+ '\tiny' => { Type => 'local' },
+ '\small' => { Type => 'local' },
+ '\scriptsize' => { Type => 'local' },
+ '\footnotesize' =>{ Type => 'local' }
+);
+
+my %MyTokens= (
+ '\tiny' => { Type => 'local' },
+ '\small' => { Type => 'local' },
+ '\scriptsize' => { Type => 'local' },
+ '\footnotesize' =>
+ { Type => 'local' },
+);
+
+==> b1404.par <==
+--add-trailing-commas
+--noadd-whitespace
+--continuation-indentation=6
+--delete-trailing-commas
+--extended-continuation-indentation
+--keep-old-breakpoints-before='Q'
+--maximum-line-length=47
+--want-trailing-commas='i'
+
==> b146.in <==
# State 1
diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index 00b9ff54..d12e150d 100644
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -8017,8 +8017,9 @@ sub match_trailing_comma_rule {
# '1' or '*' : every list should have a trailing comma
# 'm' a multi-line list should have a trailing commas
# 'b' trailing commas should be 'bare' (comma followed by newline)
- # 'h' lists of key=>value pairs should have a bare trailing comma
- # 'i' same as s=h but also include any list with about one comma per line
+ # 'h' lists of key=>value pairs with a bare trailing comma
+ # 'i' same as s=h but also include any list with no more than about one
+ # comma per line
# ' ' or -wtc not defined : leave trailing commas unchanged [DEFAULT].
# Note: an interesting generalization would be to let an upper case
@@ -8057,6 +8058,7 @@ sub match_trailing_comma_rule {
my $iline_first = $self->[_rfirst_comma_line_index_]->{$type_sequence};
my $iline_last = $rLL_new->[$Kp]->[_LINE_INDEX_];
my $has_multiline_commas;
+ my $line_diff_commas = 0;
if ( !defined($iline_first) ) {
# shouldn't happen if caller checked comma count
@@ -8066,7 +8068,7 @@ sub match_trailing_comma_rule {
) if (DEVEL_MODE);
}
else {
- my $line_diff_commas = $iline_first < $iline_last;
+ $line_diff_commas = $iline_last - $iline_first;
$has_multiline_commas = $line_diff_commas > 0;
}
@@ -8076,7 +8078,7 @@ sub match_trailing_comma_rule {
my $is_multiline =
$if_add ? $has_multiline_commas : $has_multiline_containers;
- my $is_bare_comma = $is_multiline && $KK == $Kfirst;
+ my $is_bare_multiline_comma = $is_multiline && $KK == $Kfirst;
my $match;
@@ -8087,115 +8089,62 @@ sub match_trailing_comma_rule {
$match = 0;
}
- #----------------------------
+ #------------------------------
# '*' or '1' : matches any list
- #----------------------------
+ #------------------------------
elsif ( $trailing_comma_style eq '*' || $trailing_comma_style eq '1' ) {
$match = 1;
}
- #---------------------------
+ #-----------------------------
# 'm' matches a Multiline list
- #---------------------------
+ #-----------------------------
elsif ( $trailing_comma_style eq 'm' ) {
$match = $is_multiline;
}
- #--------------------------------
+ #----------------------------------
# 'b' matches a Bare trailing comma
- #--------------------------------
+ #----------------------------------
elsif ( $trailing_comma_style eq 'b' ) {
- $match = $is_bare_comma;
+ $match = $is_bare_multiline_comma;
}
- #------------------------------------------------------------------
- # 'h' matches a bare stable list of key=>values ('h' is for 'Hash')
- # 'i' same as 'h' but also matches stable single field lists with about 1
- # comma per line.
- #------------------------------------------------------------------
+ #--------------------------------------------------------------------------
+ # 'h' matches a bare hash list with about 1 comma and 1 fat comma per line.
+ # 'i' matches a bare stable list with about 1 comma per line.
+ #--------------------------------------------------------------------------
elsif ( $trailing_comma_style eq 'h' || $trailing_comma_style eq 'i' ) {
- # This is a minimal style which can put trailing commas where
- # they are most useful - at the end of simple lists which might,
- # for example, need to be sorted.
+ # We can treat these together because they are similar.
+ # The set of 'i' matches includes the set of 'h' matches.
- return if ( !$is_bare_comma );
+ # the trailing comma must be bare for both 'h' and 'i'
+ return if ( !$is_bare_multiline_comma );
- my $blank_line_count =
- $self->[_rblank_and_comment_count_]->{$type_sequence};
- $blank_line_count = 0 unless ( defined($blank_line_count) );
-
- # This is the count if the parens are on separate lines from the list:
- my $required_comma_count =
- $line_diff_containers - 2 - $blank_line_count;
- my $comma_count = $rtype_count->{','};
-
- # The comma tests here are based on number of interior commas,
- # so subtract 1 if we are at a trailing comma.
- $comma_count -= 1 if ( !$if_add );
-
- return if ( $comma_count != $required_comma_count );
-
- # The -lp style has a special 2-line mode which uses the vertical
- # aligner to move the closing paren to be at the end of the previous
- # line. So if we add a comma it will be covered, and it may not
- # be possible to remove it with -dtc.
- my $min_comma_count = 1;
- if ( $rOpts_line_up_parentheses && !$is_permanently_broken ) {
-
- # This test is like to the test in sub set_vertical_tightness_flags
- # but we do not yet know if this container will use -lp formatting
- # so we have to assume that it will.
- my $token_K = $rLL->[$KK]->[_TOKEN_];
- if ( $token_K eq ')' ) { $min_comma_count = 2 }
- }
-
- #---------------------------------------------------------
- # Styles 'h' and 'i': check for a stable key=>value list
- #---------------------------------------------------------
+ # there must be no more than one comma per line for both 'h' and 'i'
+ my $new_comma_count = $rtype_count->{','};
+ $new_comma_count += 1 if ($if_add);
+ return if ( $new_comma_count > $line_diff_commas + 1 );
+ # a list of key=>value pairs with at least 2 fat commas is a match
+ # for both 'h' and 'i'
my $fat_comma_count = $rtype_count->{'=>'};
- $fat_comma_count = 0 unless defined($fat_comma_count);
+ if ( $fat_comma_count && $fat_comma_count >= 2 ) {
- # For a perfect key value list missing 1 comma we should use:
- # $rtype_count->{'=>'} == $required_comma_count + 1
- # but to provide mercy for a list with one item without a fat comma,
- # we can use:
- # $rtype_count->{'=>'} >= $required_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 )
- )
- {
- $match = 1;
+ # comma count (including trailer) and fat comma count must differ by
+ # by no more than 1. This allows for some small variations.
+ my $comma_diff = $new_comma_count - $fat_comma_count;
+ $match = ( $comma_diff >= -1 && $comma_diff <= 1 );
}
- #--------------------------------------------------------------
- # Style 'i': check for a stable single-field list of
- # items stabilized by blank lines, comments, or the -boc flag
- #--------------------------------------------------------------
- if ( !$match && $trailing_comma_style eq 'i' ) {
-
- # We are looking for lists with <= 1 comma per line
- if (
- $line_diff_containers > $comma_count
- && ( $is_permanently_broken
- || $rOpts_break_at_old_comma_breakpoints )
- )
- {
- $match = 1;
- }
+ # For 'i' only, a list that can be shown to be stable is a match
+ if ( $trailing_comma_style eq 'i' ) {
+ $match ||= (
+ $is_permanently_broken
+ || ( $rOpts_break_at_old_comma_breakpoints
+ && !$rOpts_ignore_old_breakpoints )
+ );
}
}
@@ -8238,7 +8187,6 @@ sub match_trailing_comma_rule {
}
}
}
-
return $match;
}
diff --git a/t/snippets/expect/wtc.def b/t/snippets/expect/wtc.def
index dfcb3540..3ac7946e 100644
--- a/t/snippets/expect/wtc.def
+++ b/t/snippets/expect/wtc.def
@@ -16,10 +16,10 @@ $text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
my $new = {
%$item,
text => $leaf,
- color => 'green'
+ color => 'green',
};
-# and this
+# matches 'i'
my @list = (
$xx,
diff --git a/t/snippets/expect/wtc.wtc1 b/t/snippets/expect/wtc.wtc1
index ce6e79c8..615295ed 100644
--- a/t/snippets/expect/wtc.wtc1
+++ b/t/snippets/expect/wtc.wtc1
@@ -19,7 +19,7 @@ my $new = {
color => 'green'
};
-# and this
+# matches 'i'
my @list = (
$xx,
diff --git a/t/snippets/expect/wtc.wtc2 b/t/snippets/expect/wtc.wtc2
index 4c8d6bca..57aa571c 100644
--- a/t/snippets/expect/wtc.wtc2
+++ b/t/snippets/expect/wtc.wtc2
@@ -19,7 +19,7 @@ my $new = {
color => 'green',
};
-# and this
+# matches 'i'
my @list = (
$xx,
diff --git a/t/snippets/expect/wtc.wtc3 b/t/snippets/expect/wtc.wtc3
index fe3ff727..9fad9eb0 100644
--- a/t/snippets/expect/wtc.wtc3
+++ b/t/snippets/expect/wtc.wtc3
@@ -19,7 +19,7 @@ my $new = {
color => 'green',
};
-# and this
+# matches 'i'
my @list = (
$xx,
diff --git a/t/snippets/expect/wtc.wtc4 b/t/snippets/expect/wtc.wtc4
index 680adea7..69f70a7b 100644
--- a/t/snippets/expect/wtc.wtc4
+++ b/t/snippets/expect/wtc.wtc4
@@ -19,7 +19,7 @@ my $new = {
color => 'green',
};
-# and this
+# matches 'i'
my @list = (
$xx,
diff --git a/t/snippets/expect/wtc.wtc5 b/t/snippets/expect/wtc.wtc5
index 185b2976..10b2425e 100644
--- a/t/snippets/expect/wtc.wtc5
+++ b/t/snippets/expect/wtc.wtc5
@@ -19,7 +19,7 @@ my $new = {
color => 'green',
};
-# and this
+# matches 'i'
my @list = (
$xx,
diff --git a/t/snippets/expect/wtc.wtc6 b/t/snippets/expect/wtc.wtc6
index 11760f51..48042ed2 100644
--- a/t/snippets/expect/wtc.wtc6
+++ b/t/snippets/expect/wtc.wtc6
@@ -18,7 +18,7 @@ my $new = {
color => 'green',
};
-# and this
+# matches 'i'
my @list = (
$xx,
@@ -35,7 +35,8 @@ $dasm_frame->Button(
-text => 'Locate',
-command => sub {
$target_binary = $fs->Show( -popover => 'cursor', -create => 1 );
- } )->pack( -side => 'left' );
+ },
+)->pack( -side => 'left' );
my $no_index_1_1 =
{ 'map' => { ':key' => { name => \&string, list => { value => \&string } } }
diff --git a/t/snippets/expect/wtc.wtc7 b/t/snippets/expect/wtc.wtc7
index bed34858..e423bfce 100644
--- a/t/snippets/expect/wtc.wtc7
+++ b/t/snippets/expect/wtc.wtc7
@@ -18,7 +18,7 @@ my $new = {
color => 'green',
};
-# and this
+# matches 'i'
my @list = (
$xx,
@@ -34,7 +34,8 @@ $dasm_frame->Button(
-text => 'Locate',
-command => sub {
$target_binary = $fs->Show( -popover => 'cursor', -create => 1 );
- } )->pack( -side => 'left' );
+ },
+)->pack( -side => 'left' );
my $no_index_1_1 =
{ 'map' => { ':key' => { name => \&string, list => { value => \&string } } }
diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt
index 2627bf18..034b903a 100644
--- a/t/snippets/packing_list.txt
+++ b/t/snippets/packing_list.txt
@@ -373,6 +373,7 @@
../snippets27.t wtc.wtc6
../snippets27.t dwic.def
../snippets27.t dwic.dwic
+../snippets27.t wtc.wtc7
../snippets3.t ce_wn1.ce_wn
../snippets3.t ce_wn1.def
../snippets3.t colin.colin
@@ -513,4 +514,3 @@
../snippets9.t rt98902.def
../snippets9.t rt98902.rt98902
../snippets9.t rt99961.def
-../snippets27.t wtc.wtc7
diff --git a/t/snippets/wtc.in b/t/snippets/wtc.in
index c6149665..4e08705d 100644
--- a/t/snippets/wtc.in
+++ b/t/snippets/wtc.in
@@ -16,10 +16,10 @@ $text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
my $new = {
%$item,
text => $leaf,
- color => 'green'
+ color => 'green',
};
-# and this
+# matches 'i'
my @list = (
$xx,
diff --git a/t/snippets26.t b/t/snippets26.t
index 6694da94..c0516fcf 100644
--- a/t/snippets26.t
+++ b/t/snippets26.t
@@ -375,10 +375,10 @@ $text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
my $new = {
%$item,
text => $leaf,
- color => 'green'
+ color => 'green',
};
-# and this
+# matches 'i'
my @list = (
$xx,
@@ -913,10 +913,10 @@ $text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
my $new = {
%$item,
text => $leaf,
- color => 'green'
+ color => 'green',
};
-# and this
+# matches 'i'
my @list = (
$xx,
diff --git a/t/snippets27.t b/t/snippets27.t
index bb43faf8..42035891 100644
--- a/t/snippets27.t
+++ b/t/snippets27.t
@@ -73,10 +73,10 @@ $text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
my $new = {
%$item,
text => $leaf,
- color => 'green'
+ color => 'green',
};
-# and this
+# matches 'i'
my @list = (
$xx,
@@ -135,7 +135,7 @@ my $new = {
color => 'green'
};
-# and this
+# matches 'i'
my @list = (
$xx,
@@ -188,7 +188,7 @@ my $new = {
color => 'green',
};
-# and this
+# matches 'i'
my @list = (
$xx,
@@ -241,7 +241,7 @@ my $new = {
color => 'green',
};
-# and this
+# matches 'i'
my @list = (
$xx,
@@ -294,7 +294,7 @@ my $new = {
color => 'green',
};
-# and this
+# matches 'i'
my @list = (
$xx,
@@ -347,7 +347,7 @@ my $new = {
color => 'green',
};
-# and this
+# matches 'i'
my @list = (
$xx,
@@ -399,7 +399,7 @@ my $new = {
color => 'green',
};
-# and this
+# matches 'i'
my @list = (
$xx,
@@ -416,7 +416,8 @@ $dasm_frame->Button(
-text => 'Locate',
-command => sub {
$target_binary = $fs->Show( -popover => 'cursor', -create => 1 );
- } )->pack( -side => 'left' );
+ },
+)->pack( -side => 'left' );
my $no_index_1_1 =
{ 'map' => { ':key' => { name => \&string, list => { value => \&string } } }
@@ -479,7 +480,7 @@ my $new = {
color => 'green',
};
-# and this
+# matches 'i'
my @list = (
$xx,
@@ -495,7 +496,8 @@ $dasm_frame->Button(
-text => 'Locate',
-command => sub {
$target_binary = $fs->Show( -popover => 'cursor', -create => 1 );
- } )->pack( -side => 'left' );
+ },
+)->pack( -side => 'left' );
my $no_index_1_1 =
{ 'map' => { ':key' => { name => \&string, list => { value => \&string } } }
--
2.39.5