fix instability issue b1241

diff --git a/dev-bin/run_convergence_tests.pl.data b/dev-bin/run_convergence_tests.pl.data
index f79e19b0e763aa0194c8cf46d331a51ac3cd8121..dc64ae2380c627a820b08dcbb6ab25db81dc158c 100644 (file)
--- a/dev-bin/run_convergence_tests.pl.data
+++ b/dev-bin/run_convergence_tests.pl.data
@@ -8011,6 +8011,34 @@ is(
 --space-keyword-paren
 --weld-nested-containers
 
+==> b1241.in <==
+# created from b901
+# Started blinking with new -lp logic
+# S1
+    my @tagged_texts = walk_html(
+                          $tree,
+                          sub
+                          { [ 'MAYBE', $_[ 0 ] ] },
+                          \&promote_if_h1tag
+    );
+
+# S2
+    my @tagged_texts =
+             walk_html(
+                        $tree,
+                        sub { [
+                              'MAYBE', $_[ 0 ] ] },
+                        \&promote_if_h1tag
+             );
+
+==> b1241.par <==
+--continuation-indentation=9
+--line-up-parentheses
+--maximum-line-length=51
+--opening-anonymous-sub-brace-on-new-line
+--square-bracket-tightness=0
+--weld-nested-containers
+
 ==> b131.in <==
         unless
           ( open( SCORE, "+>>$Score_File" ) )

diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index 3a9a7021c433878a8eaa0d8ab47aab8e7fa641de..659036fa2cd804b0410c90eb9338b3cf7237e5b5 100644 (file)
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -8307,13 +8307,13 @@ sub weld_nested_containers {
     # involves setting certain hash values which will be checked
     # later during formatting.
 
-    my $rLL                  = $self->[_rLL_];
-    my $rlines               = $self->[_rlines_];
-    my $K_opening_container  = $self->[_K_opening_container_];
-    my $K_closing_container  = $self->[_K_closing_container_];
-    my $rblock_type_of_seqno = $self->[_rblock_type_of_seqno_];
-
+    my $rLL                       = $self->[_rLL_];
+    my $rlines                    = $self->[_rlines_];
+    my $K_opening_container       = $self->[_K_opening_container_];
+    my $K_closing_container       = $self->[_K_closing_container_];
+    my $rblock_type_of_seqno      = $self->[_rblock_type_of_seqno_];
     my $ris_excluded_lp_container = $self->[_ris_excluded_lp_container_];
+    my $ris_asub_block            = $self->[_ris_asub_block_];
 
     # Find nested pairs of container tokens for any welding.
     my $rnested_pairs = $self->find_nested_pairs();
@@ -8671,6 +8671,17 @@ EOM
               if ( $token_oo eq '(' || $iline_oo != $iline_io );
         }
 
+        # DO-NOT-WELD RULE 2A:
+        # Do not weld an opening asub brace in -lp mode to avoid interfering
+        # with one-line block formation.  Fixes b1241.
+        if (  !$do_not_weld_rule
+            && $is_one_line_weld
+            && $rOpts_line_up_parentheses
+            && $ris_asub_block->{$outer_seqno} )
+        {
+            $do_not_weld_rule = '2A';
+        }
+
         # DO-NOT-WELD RULE 3:
         # Do not weld if this makes our line too long.
         # Use a tolerance which depends on if the old tokens were welded