fixed some strange alignments, added some tests

diff --git a/lib/Perl/Tidy/VerticalAligner.pm b/lib/Perl/Tidy/VerticalAligner.pm
index b1ddc7b93792836633cbd231d1365aeb0a9965b1..c27e2eaf32534758f30abd4e7d1cc7821b5a9542 100644 (file)
--- a/lib/Perl/Tidy/VerticalAligner.pm
+++ b/lib/Perl/Tidy/VerticalAligner.pm
@@ -2384,7 +2384,7 @@ sub delete_unmatched_tokens {
               decode_alignment_token($tok);
             if ( !defined($lev_min) || $lev < $lev_min ) { $lev_min = $lev }
 
-           # Possible future upgrade: for multiple matches, 
+            # Possible future upgrade: for multiple matches,
             # record [$i1, $i2, ..] instead of $i
             $rhash->{$tok} =
               [ $i, undef, undef, $raw_tok, $lev, $tag, $tok_count ];
@@ -2471,10 +2471,6 @@ sub delete_unmatched_tokens {
             }
         }
 
-        # OLD: Leave two lines alone unless they are an if/else or ternary.
-        # NEW: Treat two lines the same as longer runs; results are better.
-        ## next if ( $nlines <= 2 && !$is_full_block );
-
         # remove unwanted alignment tokens
         for ( my $jj = $jbeg ; $jj <= $jend ; $jj++ ) {
             my $line    = $rnew_lines->[$jj];
@@ -2484,7 +2480,7 @@ sub delete_unmatched_tokens {
             my $i_eq    = $i_equals[$jj];
             my @idel;
             my $imax = @{$rtokens} - 2;
-            my $deletion_level;
+            my $delete_above_level;
 
             for ( my $i = 0 ; $i <= $imax ; $i++ ) {
                 my $tok = $rtokens->[$i];
@@ -2500,19 +2496,21 @@ sub delete_unmatched_tokens {
                 $delete_me ||=
                   ( $is_full_block && $token_line_count{$tok} < $nlines );
 
-                # remove tagged alignment tokens following a => deletion until
-                # a lower level is reached because the tags will now be
-                # incorrect. For example, this will prevent aligning
-                # commas as follows after deleting the second =>
+                # Remove all tokens above a certain level following a previous
+                # deletion.  For example, we have to remove tagged higher level
+                # alignment tokens following a => deletion because the tags of
+                # higher level tokens will now be incorrect. For example, this
+                # will prevent aligning commas as follows after deleting the
+                # second =>
                 #    $w->insert(
                 #      ListBox => origin => [ 270, 160 ],
                 #      size    => [ 200,           55 ],
                 #    );
-                if ( defined($deletion_level) ) {
-                    if ( $lev >= $deletion_level ) {
-                        $delete_me ||= $tag;
+                if ( defined($delete_above_level) ) {
+                    if ( $lev > $delete_above_level ) {
+                        $delete_me ||= 1;    #$tag;
                     }
-                    else { $deletion_level = undef }
+                    else { $delete_above_level = undef }
                 }
 
                 if (
@@ -2529,10 +2527,18 @@ sub delete_unmatched_tokens {
                   )
                 {
                     push @idel, $i;
-                    if ( $raw_tok eq '=>' ) {
-                        $deletion_level = $lev
-                          if ( !defined($deletion_level)
-                            || $lev < $deletion_level );
+                    if ( !defined($delete_above_level)
+                        || $lev < $delete_above_level )
+                    {
+
+                        # delete all following higher level alignments
+                        $delete_above_level = $lev;
+
+                        # but keep deleting after => to next lower level
+                        # to avoid some bizarre alignments
+                        if ( $raw_tok eq '=>' ) {
+                            $delete_above_level = $lev - 1;
+                        }
                     }
                 }
             }

diff --git a/t/snippets/almost1.in b/t/snippets/almost1.in
new file mode 100644 (file)
index 0000000..3b071d4
--- /dev/null
+++ b/t/snippets/almost1.in
@@ -0,0 +1,3 @@
+# not a good alignment
+my $realname     = catfile( $dir,                  $file );
+my $display_name = defined $disp ? catfile( $disp, $file ) : $file;

diff --git a/t/snippets/almost2.in b/t/snippets/almost2.in
new file mode 100644 (file)
index 0000000..ebf7656
--- /dev/null
+++ b/t/snippets/almost2.in
@@ -0,0 +1,3 @@
+# not a good alignment
+my $substname = ( $indtot > 1            ? $indname . $indno : $indname );
+my $incname   = $indname . ( $indtot > 1 ? $indno            : "" );

diff --git a/t/snippets/almost3.in b/t/snippets/almost3.in
new file mode 100644 (file)
index 0000000..a6e8ff5
--- /dev/null
+++ b/t/snippets/almost3.in
@@ -0,0 +1,6 @@
+# not a good alignment
+sub head {
+    match_on_type @_ => Null => sub { die "Cannot get head of Null" },
+      ArrayRef       => sub         { $_->[0] };
+}
+

diff --git a/t/snippets/expect/almost1.def b/t/snippets/expect/almost1.def
new file mode 100644 (file)
index 0000000..6eac6e3
--- /dev/null
+++ b/t/snippets/expect/almost1.def
@@ -0,0 +1,3 @@
+# not a good alignment
+my $realname     = catfile( $dir, $file );
+my $display_name = defined $disp ? catfile( $disp, $file ) : $file;

diff --git a/t/snippets/expect/almost2.def b/t/snippets/expect/almost2.def
new file mode 100644 (file)
index 0000000..0dfaeda
--- /dev/null
+++ b/t/snippets/expect/almost2.def
@@ -0,0 +1,3 @@
+# not a good alignment
+my $substname = ( $indtot > 1 ? $indname . $indno : $indname );
+my $incname   = $indname . ( $indtot > 1 ? $indno : "" );

diff --git a/t/snippets/expect/almost3.def b/t/snippets/expect/almost3.def
new file mode 100644 (file)
index 0000000..25e9521
--- /dev/null
+++ b/t/snippets/expect/almost3.def
@@ -0,0 +1,6 @@
+# not a good alignment
+sub head {
+    match_on_type @_ => Null => sub { die "Cannot get head of Null" },
+      ArrayRef => sub { $_->[0] };
+}
+

diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt
index 0579675d2f86d76a247649d97b0362cca5e59d2f..36c2f9dd2f44a781668a183e76cd4c9b6b281b6a 100644 (file)
--- a/t/snippets/packing_list.txt
+++ b/t/snippets/packing_list.txt
@@ -142,6 +142,7 @@
 ../snippets16.t        git10.def
 ../snippets16.t        git10.git10
 ../snippets16.t        multiple_equals.def
+../snippets16.t        align31.def
 ../snippets2.t angle.def
 ../snippets2.t arrows1.def
 ../snippets2.t arrows2.def
@@ -302,4 +303,6 @@
 ../snippets9.t rt98902.def
 ../snippets9.t rt98902.rt98902
 ../snippets9.t rt99961.def
-../snippets16.t        align31.def
+../snippets16.t        almost1.def
+../snippets16.t        almost2.def
+../snippets16.t        almost3.def

diff --git a/t/snippets16.t b/t/snippets16.t
index 79ac28efb044291357f9af2541b6412288159561..57af6e473e0628d4183d4d266b2b0648c72a37b6 100644 (file)
--- a/t/snippets16.t
+++ b/t/snippets16.t
@@ -8,6 +8,9 @@
 #5 git10.git10
 #6 multiple_equals.def
 #7 align31.def
+#8 almost1.def
+#9 almost2.def
+#10 almost3.def
 
 # To locate test #13 you can search for its name or the string '#13'
 
@@ -42,6 +45,27 @@ $w->insert(
     ListBox => origin => [ 270, 160 ],
     size    => [ 200,           55 ],
 );
+----------
+
+        'almost1' => <<'----------',
+# not a good alignment
+my $realname     = catfile( $dir,                  $file );
+my $display_name = defined $disp ? catfile( $disp, $file ) : $file;
+----------
+
+        'almost2' => <<'----------',
+# not a good alignment
+my $substname = ( $indtot > 1            ? $indname . $indno : $indname );
+my $incname   = $indname . ( $indtot > 1 ? $indno            : "" );
+----------
+
+        'almost3' => <<'----------',
+# not a good alignment
+sub head {
+    match_on_type @_ => Null => sub { die "Cannot get head of Null" },
+      ArrayRef       => sub         { $_->[0] };
+}
+
 ----------
 
         'git10' => <<'----------',
@@ -173,6 +197,39 @@ $w->insert(
 );
 #7...........
         },
+
+        'almost1.def' => {
+            source => "almost1",
+            params => "def",
+            expect => <<'#8...........',
+# not a good alignment
+my $realname     = catfile( $dir, $file );
+my $display_name = defined $disp ? catfile( $disp, $file ) : $file;
+#8...........
+        },
+
+        'almost2.def' => {
+            source => "almost2",
+            params => "def",
+            expect => <<'#9...........',
+# not a good alignment
+my $substname = ( $indtot > 1 ? $indname . $indno : $indname );
+my $incname   = $indname . ( $indtot > 1 ? $indno : "" );
+#9...........
+        },
+
+        'almost3.def' => {
+            source => "almost3",
+            params => "def",
+            expect => <<'#10...........',
+# not a good alignment
+sub head {
+    match_on_type @_ => Null => sub { die "Cannot get head of Null" },
+      ArrayRef => sub { $_->[0] };
+}
+
+#10...........
+        },
     };
 
     my $ntests = 0 + keys %{$rtests};