fixed minor alignment problem involving mutiple fat commas

diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index 8d395c1b62b0f933a8dfd70e014a3d6e2de67843..27cece4375c60c354eed3dfff7a3b34b21c0ef95 100644 (file)
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -2938,16 +2938,16 @@ sub respace_tokens {
 
                 if ( $token =~ /$SUB_PATTERN/ ) {
 
-                   # -spp = 0 : no space before opening prototype paren
-                   # -spp = 1 : stable (follow input spacing)
-                   # -spp = 2 : always space before opening prototype paren
+                    # -spp = 0 : no space before opening prototype paren
+                    # -spp = 1 : stable (follow input spacing)
+                    # -spp = 2 : always space before opening prototype paren
                     my $spp = $rOpts->{'space-prototype-paren'};
                     if ( defined($spp) ) {
                         if    ( $spp == 0 ) { $token =~ s/\s+\(/\(/; }
                         elsif ( $spp == 2 ) { $token =~ s/\(/ (/; }
                     }
 
-                   # one space max, and no tabs
+                    # one space max, and no tabs
                     $token =~ s/\s+/ /g;
                     $rtoken_vars->[_TOKEN_] = $token;
                 }
@@ -3949,24 +3949,24 @@ sub weld_nested_containers {
         $do_not_weld ||= $excess_length_to_K->($Kinner_opening) > 0;
 
         # DO-NOT-WELD RULE 4; implemented for git#10:
-       # Do not weld an opening -ce brace if the next container is on a single
-       # line, different from the opening brace. (This is very rare).  For
-       # example, given the following with -ce, we will avoid joining the {
-       # and [
-          
+        # Do not weld an opening -ce brace if the next container is on a single
+        # line, different from the opening brace. (This is very rare).  For
+        # example, given the following with -ce, we will avoid joining the {
+        # and [
+
         #  } else {
         #      [ $_, length($_) ]
         #  }
-        
-       # because this would produce a terminal one-line block:
+
+        # because this would produce a terminal one-line block:
 
         #  } else { [ $_, length($_) ]  }
 
-       # which may not be what is desired. But given this input:
+        # which may not be what is desired. But given this input:
 
         #  } else { [ $_, length($_) ]  }
 
-       # then we will do the weld and retain the one-line block
+        # then we will do the weld and retain the one-line block
         if ( $rOpts->{'cuddled-else'} ) {
             my $block_type = $rLL->[$Kouter_opening]->[_BLOCK_TYPE_];
             if ( $block_type && $rcuddled_block_types->{'*'}->{$block_type} ) {
@@ -5232,7 +5232,7 @@ sub token_sequence_length {
     # return length of tokens ($ibeg .. $iend) including $ibeg & $iend
     # returns 0 if $ibeg > $iend (shouldn't happen)
     my ( $ibeg, $iend ) = @_;
-    return 0 if ( $iend < 0 || $ibeg > $iend );
+    return 0                                  if ( $iend < 0 || $ibeg > $iend );
     return $summed_lengths_to_go[ $iend + 1 ] if ( $ibeg < 0 );
     return $summed_lengths_to_go[ $iend + 1 ] - $summed_lengths_to_go[$ibeg];
 }
@@ -10127,7 +10127,7 @@ sub send_lines_to_vertical_aligner {
         my $j = 0;    # field index
 
         $patterns[0] = "";
-       my %token_count; 
+        my %token_count;
         for my $i ( $ibeg .. $iend ) {
 
             # Keep track of containers balanced on this line only.
@@ -10197,13 +10197,20 @@ sub send_lines_to_vertical_aligner {
                     # if we are not aligning on this paren...
                     if ( $matching_token_to_go[$i] eq '' ) {
 
-                        # Sum length from previous alignment, or start of line.
-                        my $len =
-                          ( $i_start == $ibeg )
-                          ? total_line_length( $i_start, $i - 1 )
-                          : token_sequence_length( $i_start, $i - 1 );
+                        # Sum length from previous alignment
+                        my $len = token_sequence_length( $i_start, $i - 1 );
+                        if ( $i_start == $ibeg ) {
+
+                            # For first token, use distance from start of line
+                            # but subtract off the indentation due to level.
+                            # Otherwise, results could vary with indentation.
+                            $len += leading_spaces_to_go($ibeg) -
+                              $levels_to_go[$i_start] * $rOpts_indent_columns;
+                            if ( $len < 0 ) { $len = 0 }
+                        }
 
-                        # tack length onto the container name to make unique
+                        # tack this length onto the container name to try
+                        # to make a unique token name
                         $container_name[$depth] .= "-" . $len;
                     }
                 }
@@ -10279,17 +10286,17 @@ sub send_lines_to_vertical_aligner {
                     $tok .= $block_type;
                 }
 
-               # Mark multiple copies of certain tokens with the copy number
-               # This will allow the aligner to decide if they are matched.
-               # For now, only do this for equals. For example, the two
-               # equals on the next line will be labeled '=0' and '=0.2'.
-               # Later, the '=0.2' will be ignored in alignment because it
-               # has no match.
-
-               # $|          = $debug = 1 if $opt_d;
-               # $full_index = 1          if $opt_i;
-               
-                if ( $raw_tok eq '=' ) {
+                # Mark multiple copies of certain tokens with the copy number
+                # This will allow the aligner to decide if they are matched.
+                # For now, only do this for equals. For example, the two
+                # equals on the next line will be labeled '=0' and '=0.2'.
+                # Later, the '=0.2' will be ignored in alignment because it
+                # has no match.
+
+                # $|          = $debug = 1 if $opt_d;
+                # $full_index = 1          if $opt_i;
+
+                if ( $raw_tok eq '=' || $raw_tok eq '=>' ) {
                     $token_count{$tok}++;
                     if ( $token_count{$tok} > 1 ) {
                         $tok .= '.' . $token_count{$tok};
@@ -11530,7 +11537,7 @@ sub get_seqno {
             $vert_last_nonblank_block_type        = '';
 
             # look at each token in this output line..
-           my $level_beg = $levels_to_go[$ibeg];
+            my $level_beg = $levels_to_go[$ibeg];
             foreach my $i ( $ibeg .. $iend ) {
                 my $alignment_type = '';
                 my $type           = $types_to_go[$i];
@@ -11637,8 +11644,8 @@ sub get_seqno {
                           /^(if|unless|elsif)$/;
                     }
 
-                   # Skip empty containers like '{}' and '()'
-                   # which are at a higher level than the line beginning
+                    # Skip empty containers like '{}' and '()'
+                    # which are at a higher level than the line beginning
                     my $seqno = $type_sequence_to_go[$i];
                     if (   $seqno
                         && $i < $iend

diff --git a/lib/Perl/Tidy/VerticalAligner.pm b/lib/Perl/Tidy/VerticalAligner.pm
index 08a308d49a842237ce68b0987a16fc09f6ea45f6..b1ddc7b93792836633cbd231d1365aeb0a9965b1 100644 (file)
--- a/lib/Perl/Tidy/VerticalAligner.pm
+++ b/lib/Perl/Tidy/VerticalAligner.pm
@@ -2384,7 +2384,10 @@ sub delete_unmatched_tokens {
               decode_alignment_token($tok);
             if ( !defined($lev_min) || $lev < $lev_min ) { $lev_min = $lev }
 
-            $rhash->{$tok} = [ $i, undef, undef, $lev ];
+           # Possible future upgrade: for multiple matches, 
+            # record [$i1, $i2, ..] instead of $i
+            $rhash->{$tok} =
+              [ $i, undef, undef, $raw_tok, $lev, $tag, $tok_count ];
 
             # remember the first equals at line level
             if ( !defined($i_eq) && $raw_tok eq '=' ) {
@@ -2481,11 +2484,13 @@ sub delete_unmatched_tokens {
             my $i_eq    = $i_equals[$jj];
             my @idel;
             my $imax = @{$rtokens} - 2;
+            my $deletion_level;
 
             for ( my $i = 0 ; $i <= $imax ; $i++ ) {
                 my $tok = $rtokens->[$i];
                 next if ( $tok eq '#' );    # shouldn't happen
-                my ( $il, $ir ) = @{ $rhash->{$tok} }[ 1, 2 ];
+                my ( $iii, $il, $ir, $raw_tok, $lev, $tag, $tok_count ) =
+                  @{ $rhash->{$tok} };
 
                 # always remove unmatched tokens
                 my $delete_me = !defined($il) && !defined($ir);
@@ -2495,6 +2500,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 =>
+                #    $w->insert(
+                #      ListBox => origin => [ 270, 160 ],
+                #      size    => [ 200,           55 ],
+                #    );
+                if ( defined($deletion_level) ) {
+                    if ( $lev >= $deletion_level ) {
+                        $delete_me ||= $tag;
+                    }
+                    else { $deletion_level = undef }
+                }
+
                 if (
                     $delete_me
                     && is_deletable_token( $tok, $i, $imax, $jj, $i_eq )
@@ -2509,6 +2529,11 @@ sub delete_unmatched_tokens {
                   )
                 {
                     push @idel, $i;
+                    if ( $raw_tok eq '=>' ) {
+                        $deletion_level = $lev
+                          if ( !defined($deletion_level)
+                            || $lev < $deletion_level );
+                    }
                 }
             }
 

diff --git a/t/snippets/align31.in b/t/snippets/align31.in
new file mode 100644 (file)
index 0000000..e2e125d
--- /dev/null
+++ b/t/snippets/align31.in
@@ -0,0 +1,5 @@
+# do not align the commas
+$w->insert(
+    ListBox => origin => [ 270, 160 ],
+    size    => [ 200,           55 ],
+);

diff --git a/t/snippets/expect/align31.def b/t/snippets/expect/align31.def
new file mode 100644 (file)
index 0000000..995d219
--- /dev/null
+++ b/t/snippets/expect/align31.def
@@ -0,0 +1,5 @@
+# do not align the commas
+$w->insert(
+    ListBox => origin => [ 270, 160 ],
+    size    => [ 200, 55 ],
+);

diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt
index ae9a2a3bc1b1fcf6320fe0073c3d1f67cf875a30..0579675d2f86d76a247649d97b0362cca5e59d2f 100644 (file)
--- a/t/snippets/packing_list.txt
+++ b/t/snippets/packing_list.txt
@@ -302,3 +302,4 @@
 ../snippets9.t rt98902.def
 ../snippets9.t rt98902.rt98902
 ../snippets9.t rt99961.def
+../snippets16.t        align31.def

diff --git a/t/snippets16.t b/t/snippets16.t
index 951532371a23b38bc912ab731c7294db25b5279e..79ac28efb044291357f9af2541b6412288159561 100644 (file)
--- a/t/snippets16.t
+++ b/t/snippets16.t
@@ -7,6 +7,7 @@
 #4 git10.def
 #5 git10.git10
 #6 multiple_equals.def
+#7 align31.def
 
 # To locate test #13 you can search for its name or the string '#13'
 
@@ -35,6 +36,14 @@ BEGIN {
     ############################
     $rsources = {
 
+        'align31' => <<'----------',
+# do not align the commas
+$w->insert(
+    ListBox => origin => [ 270, 160 ],
+    size    => [ 200,           55 ],
+);
+----------
+
         'git10' => <<'----------',
 # perltidy -wn -ce -cbl=sort,map,grep
 @sorted = map {
@@ -152,6 +161,18 @@ $start = $end = $len = $ismut = $number = $allele_ori = $allele_mut =
   $proof = $xxxxreg = $reg = $dist = '';
 #6...........
         },
+
+        'align31.def' => {
+            source => "align31",
+            params => "def",
+            expect => <<'#7...........',
+# do not align the commas
+$w->insert(
+    ListBox => origin => [ 270, 160 ],
+    size    => [ 200, 55 ],
+);
+#7...........
+        },
     };
 
     my $ntests = 0 + keys %{$rtests};