From a0254b6056a30ee6f1cc03e4b4a6405b17b91baf Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Sat, 28 Mar 2020 10:29:38 -0700 Subject: [PATCH] improve -wn rules slightly (split rule 2 into 2a and 2b) --- lib/Perl/Tidy/Formatter.pm | 31 ++++++++++++++++++++--- t/snippets/expect/wn7.def | 11 ++++++++ t/snippets/expect/wn7.wn | 9 +++++++ t/snippets/packing_list.txt | 2 ++ t/snippets/wn7.in | 10 ++++++++ t/snippets17.t | 50 +++++++++++++++++++++++++++++++++++++ 6 files changed, 110 insertions(+), 3 deletions(-) create mode 100644 t/snippets/expect/wn7.def create mode 100644 t/snippets/expect/wn7.wn create mode 100644 t/snippets/wn7.in diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index bef619f7..a2a3037c 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -4235,8 +4235,8 @@ sub weld_nested_containers { my $iline_ic = $inner_closing->[_LINE_INDEX_]; - # DO-NOT-WELD RULE 2: - # Do not weld an opening paren to an inner one line brace block + # DO-NOT-WELD RULE 2a: + # Do not weld an opening paren to an inner one line sub block # We will just use old line numbers for this test and require # iterations if necessary for convergence @@ -4263,7 +4263,28 @@ sub weld_nested_containers { my $token_oo = $outer_opening->[_TOKEN_]; my $block_type_io = $inner_opening->[_BLOCK_TYPE_]; my $token_io = $inner_opening->[_TOKEN_]; - $do_not_weld ||= $token_oo eq '(' && $token_io eq '{'; + my $type_io = $inner_opening->[_TYPE_]; + $do_not_weld ||= + $token_oo eq '(' + && $token_io eq '{' + && $block_type_io =~ /$SUB_PATTERN/ + || $block_type_io =~ /$ASUB_PATTERN/; + } + + # DO-NOT-WELD RULE 2b: + # Do not weld to open hash brace which is not separated from its closing + # brace by two lines. We want to avoid something like this + # foreach + # (@{$numbers{$num}->{$num . $rowcode . $colcode}}) + # and prefer this: + # $Self->_Add( + # $SortOrderDisplay{$Field->GenerateFieldForSelectSQL()}); + # instead of this: + # $Self->_Add($SortOrderDisplay{$Field + # ->GenerateFieldForSelectSQL()}); + if ( $iline_ic - $iline_io < 2 ) { + my $type_io = $inner_opening->[_TYPE_]; + $do_not_weld ||= $type_io eq 'L'; } # DO-NOT-WELD RULE 3: @@ -12567,6 +12588,10 @@ sub terminal_type_K { # $a->$b($c); $binary_bond_strength{'i'}{'->'} = 1.45 * STRONG; + # Note that the following alternative strength would make the break at the + # '->' rather than opening the '('. Both have advantages and disadvantages. + # $binary_bond_strength{'i'}{'->'} = 0.5*STRONG + 0.5 * NOMINAL; # + $binary_bond_strength{'))'}{'->'} = 0.1 * STRONG + 0.9 * NOMINAL; $binary_bond_strength{']]'}{'->'} = 0.1 * STRONG + 0.9 * NOMINAL; $binary_bond_strength{'})'}{'->'} = 0.1 * STRONG + 0.9 * NOMINAL; diff --git a/t/snippets/expect/wn7.def b/t/snippets/expect/wn7.def new file mode 100644 index 00000000..9113237f --- /dev/null +++ b/t/snippets/expect/wn7.def @@ -0,0 +1,11 @@ + # illustrate wn rule 2b: do not weld to opening hash brace + # if closing brace is not >=2 lines away + $Self->_Add( + $SortOrderDisplay{ $Field->GenerateFieldForSelectSQL() } + ); + + # rule 2a forerly applied to all blocks, but now only + # applies to subs, so this weld is now okay with -wn + f( + do { 1; !!( my $x = bless [] ); } + ); diff --git a/t/snippets/expect/wn7.wn b/t/snippets/expect/wn7.wn new file mode 100644 index 00000000..0e8c9923 --- /dev/null +++ b/t/snippets/expect/wn7.wn @@ -0,0 +1,9 @@ + # illustrate wn rule 2b: do not weld to opening hash brace + # if closing brace is not >=2 lines away + $Self->_Add( + $SortOrderDisplay{ $Field->GenerateFieldForSelectSQL() } + ); + + # rule 2a forerly applied to all blocks, but now only + # applies to subs, so this weld is now okay with -wn + f( do { 1; !!( my $x = bless [] ); } ); diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt index c9b77898..263a6503 100644 --- a/t/snippets/packing_list.txt +++ b/t/snippets/packing_list.txt @@ -320,3 +320,5 @@ ../snippets9.t rt98902.def ../snippets9.t rt98902.rt98902 ../snippets9.t rt99961.def +../snippets17.t wn7.def +../snippets17.t wn7.wn diff --git a/t/snippets/wn7.in b/t/snippets/wn7.in new file mode 100644 index 00000000..198d790b --- /dev/null +++ b/t/snippets/wn7.in @@ -0,0 +1,10 @@ + # illustrate wn rule 2b: do not weld to opening hash brace + # if closing brace is not >=2 lines away + $Self->_Add($SortOrderDisplay{$Field + ->GenerateFieldForSelectSQL()}); + + # rule 2a forerly applied to all blocks, but now only + # applies to subs, so this weld is now okay with -wn + f( + do { 1; !!(my $x = bless []); } + ); diff --git a/t/snippets17.t b/t/snippets17.t index c64b603a..b87523af 100644 --- a/t/snippets17.t +++ b/t/snippets17.t @@ -6,6 +6,8 @@ #3 signature.def #4 rperl.def #5 rperl.rperl +#6 wn7.def +#7 wn7.wn # To locate test #13 you can search for its name or the string '#13' @@ -26,6 +28,7 @@ BEGIN { 'def' => "", 'rperl' => "-l=0", 'rt132059' => "-dac", + 'wn' => "-wn", }; ############################ @@ -81,6 +84,19 @@ sub t022 ( my $subref = sub ( $cat, $id = do { state $auto_id = 0; $auto_id++ } ) { ...; }; +---------- + + 'wn7' => <<'----------', + # illustrate wn rule 2b: do not weld to opening hash brace + # if closing brace is not >=2 lines away + $Self->_Add($SortOrderDisplay{$Field + ->GenerateFieldForSelectSQL()}); + + # rule 2a forerly applied to all blocks, but now only + # applies to subs, so this weld is now okay with -wn + f( + do { 1; !!(my $x = bless []); } + ); ---------- }; @@ -202,6 +218,40 @@ sub foo_subroutine_in_main { } #5........... }, + + 'wn7.def' => { + source => "wn7", + params => "def", + expect => <<'#6...........', + # illustrate wn rule 2b: do not weld to opening hash brace + # if closing brace is not >=2 lines away + $Self->_Add( + $SortOrderDisplay{ $Field->GenerateFieldForSelectSQL() } + ); + + # rule 2a forerly applied to all blocks, but now only + # applies to subs, so this weld is now okay with -wn + f( + do { 1; !!( my $x = bless [] ); } + ); +#6........... + }, + + 'wn7.wn' => { + source => "wn7", + params => "wn", + expect => <<'#7...........', + # illustrate wn rule 2b: do not weld to opening hash brace + # if closing brace is not >=2 lines away + $Self->_Add( + $SortOrderDisplay{ $Field->GenerateFieldForSelectSQL() } + ); + + # rule 2a forerly applied to all blocks, but now only + # applies to subs, so this weld is now okay with -wn + f( do { 1; !!( my $x = bless [] ); } ); +#7........... + }, }; my $ntests = 0 + keys %{$rtests}; -- 2.39.5