improve -wn rules slightly (split rule 2 into 2a and 2b)

diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index bef619f7b2cddf33f55ce8e8eab55a45bd82c7a9..a2a3037c24310392535e6849f6e0e648184276ae 100644 (file)
--- 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 (file)
index 0000000..9113237
--- /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 (file)
index 0000000..0e8c992
--- /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 c9b77898beee03ad0833eeb5f631c465da5d3b3c..263a65038b54ff49d06983db828308492d64b483 100644 (file)
--- 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 (file)
index 0000000..198d790
--- /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 c64b603a7c3d302eaa4a915fafa0a2051f55b940..b87523af66717c4f1a13d3cd5fc6867a554d9409 100644 (file)
--- 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};