add patch to fix -xlp issue in git #138

diff --git a/CHANGES.md b/CHANGES.md
index cb76569f7ec98acae6d8f4931b3ae8702a27452a..b97d0e96176c5d757ea9224a2c6d8ccfb215687f 100644 (file)
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -2,6 +2,13 @@
 
 ## 2024 02 02.06
 
+    - Fix issue git #138 involving -xlp (--extended-line-up-parentheses).
+      When multiple-line quotes and regexes have long secondary lines, these
+      line lengths could influencing some spacing and indentation, but they
+      should not have since perltidy has no control over their indentation.
+      This has been fixed. This will mainly influence code which uses -xlp
+      and has long multi-line quotes.
+
     - Add option --minimize-continuation-indentation, -mci (see git #137).
       This flag allows perltidy to remove continuation indentation in some
       special cases where it is not really unnecessary. For a simple example,

diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index 46417e331deea433df2639cf7cffdff290be6424..230c7f05285d7398d65e53a9ba9303dfbd32fa42 100644 (file)
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -18118,6 +18118,17 @@ sub is_fragile_block_type {
                 }
             }
 
+            # If starting in quote type Q we have no control over indentation
+            # so just ignore the length of this token (see git #138)
+            elsif ( $rLL->[$K_first]->[_TYPE_] eq 'Q' ) {
+                if ( $line_of_tokens->{_starting_in_quote} ) {
+                    $K_begin_loop = $K_first + 1;
+                    next if ( $K_begin_loop > $K_last );
+                }
+            }
+            else {
+            }
+
             $K_start_multiline_qw = undef;
 
             # Find the terminal token, before any side comment

diff --git a/t/snippets/expect/git138.def b/t/snippets/expect/git138.def
new file mode 100644 (file)
index 0000000..c87bb1d
--- /dev/null
+++ b/t/snippets/expect/git138.def
@@ -0,0 +1,12 @@
+my $sth = $dbh->prepare(
+    "select * from accountlines
+  where (borrowernumber = ?) and (amountoutstanding<>0)
+  order by date"
+);
+$VAR1 = [
+    'method',
+    1,
+    'prepare',
+    'SELECT table_name, table_owner, num_rows FROM iitables
+                  where table_owner != \'$ingres\' and table_owner != \'DBA\''
+];

diff --git a/t/snippets/expect/git138.git138 b/t/snippets/expect/git138.git138
new file mode 100644 (file)
index 0000000..56e5c63
--- /dev/null
+++ b/t/snippets/expect/git138.git138
@@ -0,0 +1,10 @@
+my $sth = $dbh->prepare( "select * from accountlines
+  where (borrowernumber = ?) and (amountoutstanding<>0)
+  order by date"
+);
+$VAR1 = [ 'method',
+          1,
+          'prepare',
+          'SELECT table_name, table_owner, num_rows FROM iitables
+                  where table_owner != \'$ingres\' and table_owner != \'DBA\''
+];

diff --git a/t/snippets/git138.in b/t/snippets/git138.in
new file mode 100644 (file)
index 0000000..56e5c63
--- /dev/null
+++ b/t/snippets/git138.in
@@ -0,0 +1,10 @@
+my $sth = $dbh->prepare( "select * from accountlines
+  where (borrowernumber = ?) and (amountoutstanding<>0)
+  order by date"
+);
+$VAR1 = [ 'method',
+          1,
+          'prepare',
+          'SELECT table_name, table_owner, num_rows FROM iitables
+                  where table_owner != \'$ingres\' and table_owner != \'DBA\''
+];

diff --git a/t/snippets/git138.par b/t/snippets/git138.par
new file mode 100644 (file)
index 0000000..2182a20
--- /dev/null
+++ b/t/snippets/git138.par
@@ -0,0 +1,2 @@
+-xlp
+-vt=2

diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt
index 23bce5f7c5ac75761de6842e2a415ce41122231b..f8af3100fcb9f149996a68b0e71ad8c642c31015 100644 (file)
--- a/t/snippets/packing_list.txt
+++ b/t/snippets/packing_list.txt
@@ -417,6 +417,8 @@
 ../snippets29.t        c352.def
 ../snippets29.t        c353.c353
 ../snippets29.t        c353.def
+../snippets29.t        git137.def
+../snippets29.t        git137.git137
 ../snippets3.t ce_wn1.ce_wn
 ../snippets3.t ce_wn1.def
 ../snippets3.t colin.colin
@@ -557,5 +559,5 @@
 ../snippets9.t rt98902.def
 ../snippets9.t rt98902.rt98902
 ../snippets9.t rt99961.def
-../snippets29.t        git137.def
-../snippets29.t        git137.git137
+../snippets29.t        git138.def
+../snippets29.t        git138.git138

diff --git a/t/snippets29.t b/t/snippets29.t
index 2b430cf0aa8cbdb0af26aac0d2e7fb85a8db0707..120b74db74ea1f4e5f6f2f9cef2d1d704353519f 100644 (file)
--- a/t/snippets29.t
+++ b/t/snippets29.t
@@ -17,6 +17,8 @@
 #14 c353.def
 #15 git137.def
 #16 git137.git137
+#17 git138.def
+#18 git138.git138
 
 # To locate test #13 you can search for its name or the string '#13'
 
@@ -48,7 +50,11 @@ BEGIN {
         'git125' => "-ssp=0",
         'git135' => "--valign-wide-equals",
         'git137' => "-mci -nolq -ci=4",
-        'vsn1'   => <<'----------',
+        'git138' => <<'----------',
+-xlp
+-vt=2
+----------
+        'vsn1' => <<'----------',
 -vsn
 -gnu
 ----------
@@ -194,6 +200,19 @@ $self->blurt( "Error: No INPUT definition for type '$type', typekind '"
       . "' found" );
 ----------
 
+        'git138' => <<'----------',
+my $sth = $dbh->prepare( "select * from accountlines
+  where (borrowernumber = ?) and (amountoutstanding<>0)
+  order by date"
+);
+$VAR1 = [ 'method',
+          1,
+          'prepare',
+          'SELECT table_name, table_owner, num_rows FROM iitables
+                  where table_owner != \'$ingres\' and table_owner != \'DBA\''
+];
+----------
+
         'vsn' => <<'----------',
 @data = (
     [ "1st", "2nd", "3rd", "4th", "5th", "6th", "7th", "8th", "9th" ],
@@ -604,6 +623,42 @@ $self->blurt( "Error: No INPUT definition for type '$type', typekind '"
     . "' found" );
 #16...........
         },
+
+        'git138.def' => {
+            source => "git138",
+            params => "def",
+            expect => <<'#17...........',
+my $sth = $dbh->prepare(
+    "select * from accountlines
+  where (borrowernumber = ?) and (amountoutstanding<>0)
+  order by date"
+);
+$VAR1 = [
+    'method',
+    1,
+    'prepare',
+    'SELECT table_name, table_owner, num_rows FROM iitables
+                  where table_owner != \'$ingres\' and table_owner != \'DBA\''
+];
+#17...........
+        },
+
+        'git138.git138' => {
+            source => "git138",
+            params => "git138",
+            expect => <<'#18...........',
+my $sth = $dbh->prepare( "select * from accountlines
+  where (borrowernumber = ?) and (amountoutstanding<>0)
+  order by date"
+);
+$VAR1 = [ 'method',
+          1,
+          'prepare',
+          'SELECT table_name, table_owner, num_rows FROM iitables
+                  where table_owner != \'$ingres\' and table_owner != \'DBA\''
+];
+#18...........
+        },
     };
 
     my $ntests = 0 + keys %{$rtests};