Test length of closing multiline qw quote before welding

diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index f1ed0ceb932e3bd3b1499354a34d198b43d4add4..bb76acb629fbd1a1621c3d1cd721306c2fdc9abb 100644 (file)
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -7899,6 +7899,37 @@ sub weld_nested_quotes {
     my $starting_lentot;
     my $maximum_text_length;
 
+    my $excess_length_of_last_line = sub {
+        my ( $Kfirst, $Klast ) = @_;
+
+        # Return the excess length of the last line of a multiline qw quote.
+        # Note that we do not have to check for an ending side comment here
+        # because there will not be one if another closing container token
+        # immediately follows the closing qw container token.
+
+        my $length_before_Kfirst =
+          $Kfirst <= 0
+          ? 0
+          : $rLL->[ $Kfirst - 1 ]->[_CUMULATIVE_LENGTH_];
+
+        my $Kend = $Klast;
+
+        my $length =
+          $rLL->[$Kend]->[_CUMULATIVE_LENGTH_] - $length_before_Kfirst;
+
+        my $level           = $rLL->[$Kfirst]->[_LEVEL_];
+        my $ci_level        = $rLL->[$Kfirst]->[_CI_LEVEL_];
+        my $max_text_length = $maximum_text_length_at_level[$level] -
+          $ci_level * $rOpts_continuation_indentation;
+
+        my $excess_length = $length - $max_text_length;
+
+        DEBUG_WELD
+          && print
+"QW: Kfirst=$Kfirst, Klast=$Klast, Kend=$Kend, level=$level, ci=$ci_level, max_text_length=$max_text_length, length=$length\n";
+        return ($excess_length);
+    };
+
     my $is_single_quote = sub {
         my ( $Kbeg, $Kend, $quote_type ) = @_;
         foreach my $K ( $Kbeg .. $Kend ) {
@@ -8025,6 +8056,27 @@ sub weld_nested_quotes {
                 }
             }
 
+            # Check the length of the last line (fixes case b1039)
+            if ( !$do_not_weld ) {
+                my $rK_range_ic = $rlines->[$iline_ic]->{_rK_range};
+                my ( $Kfirst_ic, $Klast_ic ) = @{$rK_range_ic};
+                my $excess_ic =
+                  $excess_length_of_last_line->( $Kfirst_ic, $Kouter_closing );
+
+                # Allow extra space for additional welded closing container(s)
+                # and a space and comma or semicolon.
+                my $len_right_closing =
+                  $self->[_rweld_len_right_closing_]->{$outer_seqno};
+                $len_right_closing = 0 unless ( defined($len_right_closing) );
+                if ( $excess_ic + $len_right_closing + 2 > 0 ) {
+                    if (DEBUG_WELD) {
+                        $Msg .=
+"No qw weld due to excess ending line length=$excess_ic + $len_right_closing + 2 > 0\n";
+                    }
+                    $do_not_weld = 1;
+                }
+            }
+
             if ($do_not_weld) {
                 if (DEBUG_WELD) {
                     $Msg .= "Not Welding QW\n";

diff --git a/local-docs/BugLog.pod b/local-docs/BugLog.pod
index 53bcab1d8c140c55a9a95295e9e191c68b07f873..b11fdd3df3824fc4ff30b7f101c0fe4c53801fcd 100644 (file)
--- a/local-docs/BugLog.pod
+++ b/local-docs/BugLog.pod
@@ -2,6 +2,14 @@
 
 =over 4
 
+=item B<Test length of closing multiline qw quote before welding>
+
+Random testing produced an unstable state which was due to not checking for
+excessive length of the last line of a multiline qw quote.  A check was added,
+this fixes issue b1039.
+
+5 May 2021.
+
 =item B<Update welding rule to avoid blinking states>
 
 Random testing with unusual parameter combinations produced some unstable welds.
@@ -31,7 +39,7 @@ first opening token.  With this change, both of these states are stable.
 
 This update fixes cases b1082 b1102 b1106 b1115.
 
-4 May 2021.
+4 May 2021, 07efa9d.
 
 =item B<Fix problem of conflict of -otr and -lp>
 
@@ -44,7 +52,7 @@ that defeats the purpose of the original break.
 
 This fixes cases b964 b1040 b1062 b1083 b1089.
 
-4 May 2021.
+4 May 2021, 24a0d32.
 
 =item B<Add option -pvtc=3, requested in rt136417>