Do not apply -lp formatting to containers with here-doc text

diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index da7359c10dbb42f7aff5647d6339d4d633ad81ca..1704e69d846d29ac208155b0056c704178296161 100644 (file)
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -435,7 +435,6 @@ BEGIN {
         _rstarting_multiline_qw_seqno_by_K_ => $i++,
         _rending_multiline_qw_seqno_by_K_   => $i++,
         _rKrange_multiline_qw_by_seqno_     => $i++,
-        _rcontains_multiline_qw_by_seqno_   => $i++,
         _rmultiline_qw_has_extra_level_     => $i++,
         _rbreak_before_container_by_seqno_  => $i++,
         _ris_essential_old_breakpoint_      => $i++,
@@ -611,7 +610,7 @@ BEGIN {
     @q = qw( = => );
     @is_equal_or_fat_comma{@q} = (1) x scalar(@q);
 
-    @q = qw( => ; );
+    @q = qw( => ; h );
     push @q, ',';
     @is_counted_type{@q} = (1) x scalar(@q);
 
@@ -794,7 +793,6 @@ sub new {
     $self->[_rstarting_multiline_qw_seqno_by_K_] = {};
     $self->[_rending_multiline_qw_seqno_by_K_]   = {};
     $self->[_rKrange_multiline_qw_by_seqno_]     = {};
-    $self->[_rcontains_multiline_qw_by_seqno_]   = {};
     $self->[_rmultiline_qw_has_extra_level_]     = {};
 
     $self->[_rbreak_before_container_by_seqno_] = {};
@@ -5054,6 +5052,8 @@ sub respace_tokens {
     my $nonblank_token_count     = 0;
     my $last_nonblank_token_lx   = 0;
 
+    my %K_first_here_doc_by_seqno;
+
     my $set_permanently_broken = sub {
         my ($seqno) = @_;
         while ( defined($seqno) ) {
@@ -5180,6 +5180,11 @@ sub respace_tokens {
                     if ( $type eq ',' && $Ktoken_vars == $Klast_old_code ) {
                         $rlec_count_by_seqno->{$seqno}++;
                     }
+
+                    # Remember index of first here doc target
+                    if ( $type eq 'h' && !$K_first_here_doc_by_seqno{$seqno} ) {
+                        $K_first_here_doc_by_seqno{$seqno} = $KK_new;
+                    }
                 }
             }
         }
@@ -6164,6 +6169,19 @@ sub respace_tokens {
         }
     }
 
+    # Turn off -lp for containers with here-docs with text within a container,
+    # since they have their own fixed indentation.  Fixes case b1081.
+    if ($rOpts_line_up_parentheses) {
+        foreach my $seqno ( keys %K_first_here_doc_by_seqno ) {
+            my $Kh      = $K_first_here_doc_by_seqno{$seqno};
+            my $Kc      = $K_closing_container->{$seqno};
+            my $line_Kh = $rLL_new->[$Kh]->[_LINE_INDEX_];
+            my $line_Kc = $rLL_new->[$Kc]->[_LINE_INDEX_];
+            next if ( $line_Kh == $line_Kc );
+            $ris_excluded_lp_container->{$seqno} = 1;
+        }
+    }
+
     # Set a flag to turn off -cab=3 in complex structures.  Otherwise,
     # instability can occur.  When it is overridden the behavior of the closest
     # match, -cab=2, will be used instead.  This fixes cases b1096 b1113.
@@ -6215,6 +6233,8 @@ sub respace_tokens {
     $self->[_roverride_cab3_]            = $roverride_cab3;
     $self->[_ris_assigned_structure_]    = $ris_assigned_structure;
 
+    $self->[_ris_excluded_lp_container_] = $ris_excluded_lp_container;
+
     # DEBUG OPTION: make sure the new array looks okay.
     # This is no longer needed but should be retained for future development.
     DEVEL_MODE && $self->check_token_array();
@@ -9053,9 +9073,10 @@ sub find_multiline_qw {
     my $rstarting_multiline_qw_seqno_by_K = {};
     my $rending_multiline_qw_seqno_by_K   = {};
     my $rKrange_multiline_qw_by_seqno     = {};
-    my $rcontains_multiline_qw_by_seqno   = {};
     my $rmultiline_qw_has_extra_level     = {};
 
+    my $ris_excluded_lp_container = $self->[_ris_excluded_lp_container_];
+
     my $rlines = $self->[_rlines_];
     my $rLL    = $self->[_rLL_];
     my $qw_seqno;
@@ -9168,7 +9189,8 @@ EOM
                     $is_tightly_contained = 1;
                 }
             }
-            $rcontains_multiline_qw_by_seqno->{$parent_seqno} = 1
+
+            $ris_excluded_lp_container->{$parent_seqno} = 1
               unless ($is_tightly_contained);
 
             # continue up the tree marking parent containers
@@ -9177,7 +9199,7 @@ EOM
                 last
                   unless ( defined($parent_seqno)
                     && $parent_seqno ne SEQ_ROOT );
-                $rcontains_multiline_qw_by_seqno->{$parent_seqno} = 1;
+                $ris_excluded_lp_container->{$parent_seqno} = 1;
             }
         }
     }
@@ -9187,8 +9209,6 @@ EOM
     $self->[_rending_multiline_qw_seqno_by_K_] =
       $rending_multiline_qw_seqno_by_K;
     $self->[_rKrange_multiline_qw_by_seqno_] = $rKrange_multiline_qw_by_seqno;
-    $self->[_rcontains_multiline_qw_by_seqno_] =
-      $rcontains_multiline_qw_by_seqno;
     $self->[_rmultiline_qw_has_extra_level_] = $rmultiline_qw_has_extra_level;
 
     return;
@@ -18185,6 +18205,7 @@ sub get_available_spaces_to_go {
             }
 
             # add the standard increment for containers excluded by user rules
+            # or which contain here-docs or multiline qw text
             elsif ( defined($last_nonblank_seqno)
                 && $ris_excluded_lp_container->{$last_nonblank_seqno} )
             {
@@ -18197,14 +18218,6 @@ sub get_available_spaces_to_go {
                 $space_count += $standard_increment;
             }
 
-            # if this container holds a qw, add the standard increment
-            elsif ($last_nonblank_seqno
-                && $self->[_rcontains_multiline_qw_by_seqno_]
-                ->{$last_nonblank_seqno} )
-            {
-                $space_count += $standard_increment;
-            }
-
             # otherwise use the space to the first non-blank level change token
             else {
 

diff --git a/local-docs/BugLog.pod b/local-docs/BugLog.pod
index d147f3d8bb96e04ad68a48c9c6aeec603a78782d..0a6fcc1acb0067ddd0ab408379457f956ca7a9ca 100644 (file)
--- a/local-docs/BugLog.pod
+++ b/local-docs/BugLog.pod
@@ -2,20 +2,43 @@
 
 =over 4
 
+=item B<Do not apply -lp formatting to containers with here-doc text>
+
+If a container contains text of a here-doc then the indentation is fixed by
+the here-doc text, so applying -lp formatting does not work well.  So this
+update turns off the -lp formatting in this case.
+
+But note that if a container contains a here target but not the here text so it
+still gets the -lp indentation:
+
+    # perltidy -lp
+    &WH::Spell::AddSpell(
+                          "Cause Light Wounds", "WFP",
+                          "CauseLightWounds",   <<'EOH');
+    ...
+    EOH
+
+This fixes case b1081.
+
+10 May 2021.
+
+EOH
+
 =item B<Fix some edge welding cases>
 
 Some adjustments in welding coding was made to maintain stability for some
 unusual parameter combinations.
 
 This fixes cases b1111 b1112.
-9 May 2021.
+
+9 May 2021, 68f619a.
 
 =item B<Improve tolerance for welding qw quotes>
 
 The tolerance for welding qw quotes has been update to be the same as used
 for welding other tokens.  This fixes case b1129.
 
-9 May 2021.
+9 May 2021, d1de85f.
 
 =item B<Revise weld tolerances, simplify code, fix welded ci>