fix issue c353

diff --git a/lib/Perl/Tidy/VerticalAligner.pm b/lib/Perl/Tidy/VerticalAligner.pm
index 8efa75e8881df27316976a70fad170cf51cdf6ec..c6989fc0bf6db119a7eba1b63b45a2b0c2570b88 100644 (file)
--- a/lib/Perl/Tidy/VerticalAligner.pm
+++ b/lib/Perl/Tidy/VerticalAligner.pm
@@ -7,6 +7,7 @@ use Carp;
 
 our $VERSION = '20240202.03';
 use English qw( -no_match_vars );
+use Scalar::Util 'refaddr';
 use Perl::Tidy::VerticalAligner::Alignment;
 use Perl::Tidy::VerticalAligner::Line;
 
@@ -5773,27 +5774,82 @@ EOM
         return;
     }
 
+    #------------------------------------------------------
     # loop over all lines of this vertical alignment column
+    #------------------------------------------------------
+    my ( $current_alignment, $starting_colp );
     foreach my $item ( @{$rwidths} ) {
         my ( $ix, $width ) = @{$item};
-        my $line           = $rgroup_lines->[$ix];
-        my $rfields        = $line->{'rfields'};
-        my $rfield_lengths = $line->{'rfield_lengths'};
+        my $line = $rgroup_lines->[$ix];
 
         # add leading spaces to the shorter equality tokens to get
         # vertical alignment of the '=' signs
+        my $jmax  = $line->{'jmax'};
+        my $jcolp = $jcol + 1;
+
+        my @alignments = @{ $line->{'ralignments'} };
+        my $alignment  = $alignments[$jcolp];
+        my $colp       = $alignment->{column};
+
+        #------------------------------------------------------------
+        # Transfer column width changes between equivalent alignments
+        #------------------------------------------------------------
+
+        # This step keeps alignments to the right correct in case the
+        # alignment object changes but the actual alignment col does not.
+        # It is extremely rare for this to occur. Issue c353.
+
+        # nothing to do if no more real alignments on right
+        if ( $jcolp >= $jmax - 1 ) {
+            $current_alignment = undef;
+        }
+
+        # handle new rhs alignment
+        elsif ( !$current_alignment ) {
+            $current_alignment = $alignment;
+            $starting_colp     = $colp;
+        }
+
+        # handle change in existing alignment
+        elsif ( refaddr($alignment) != refaddr($current_alignment) ) {
+
+            # completely new rhs
+            if ( $starting_colp != $colp ) {
+                $starting_colp = $colp;
+            }
+            else {
+
+                # alignment transfer - see if we must increase width
+                my $current_colp = $current_alignment->{column};
+                if ( $current_colp > $colp ) {
+                    my $excess = $current_colp - $colp;
+                    my $padding_available =
+                      $line->get_available_space_on_right();
+                    if ( $excess <= $padding_available ) {
+                        $line->increase_field_width( $jcolp, $excess );
+                        $colp = $alignment->{column};
+                    }
+                }
+            }
+            $current_alignment = $alignment;
+        }
+        else {
+            # continuing with same alignment
+        }
+
+        #-----------------------
+        # add any needed padding
+        #-----------------------
         my $pad = $max_width - $width;
         if ( $pad > 0 ) {
-            my $jmax  = $line->{'jmax'};
-            my $jcolp = $jcol + 1;
 
-            # Check space and increase column width if necessary and possible
-            my @alignments = @{ $line->{'ralignments'} };
-            my $alignment  = $alignments[$jcolp];
-            my $colp       = $alignment->{column};
-            my $lenp       = $rfield_lengths->[$jcolp];
-            my $avail      = $colp - $col;
-            my $excess     = $lenp + $pad - $avail;
+            my $rfields        = $line->{'rfields'};
+            my $rfield_lengths = $line->{'rfield_lengths'};
+
+            my $lenp   = $rfield_lengths->[$jcolp];
+            my $avail  = $colp - $col;
+            my $excess = $lenp + $pad - $avail;
+
             if ( $excess > 0 ) {
                 my $padding_available = $line->get_available_space_on_right();
                 if ( $excess <= $padding_available ) {
@@ -5807,16 +5863,6 @@ EOM
             # increase the space
             $rfields->[$jcolp] = ( SPACE x $pad ) . $rfields->[$jcolp];
             $rfield_lengths->[$jcolp] += $pad;
-
-            0 && print <<EOM;
-jcol=$jcol col=$col
-jcolp=$jcolp colp=$colp
-jmax=$jmax
-avail=$avail
-len=$rfield_lengths->[$jcolp];
-text='$rfields->[$jcolp]'
-pad=$pad
-EOM
         }
     }
     return;

diff --git a/t/snippets/c353.in b/t/snippets/c353.in
new file mode 100644 (file)
index 0000000..2fee94b
--- /dev/null
+++ b/t/snippets/c353.in
@@ -0,0 +1,14 @@
+@ns        = split( /, ?/, join( ',', @ns ) );
+@cnames    = split( /, ?/, join( ',', @cnames ) );
+$recurse   = 1       unless ( defined $recurse );
+$port      = 53      unless ( defined $port );
+$srcport   = 0       unless ( defined $srcport );
+$ttl       = 30 * 60 unless ( defined $ttl );
+$hash      = 32      if ( defined $hash && $hash <= 0 );
+$hash      = 63      if ( defined $hash && $hash > 63 );
+$unique    = 1       unless ( defined $hash || defined $unique );
+$unique  ||= $hash   if (1);
+
+$basepath  = $CWD unless length($basepath);
+$basepath .= '/'  if -d $basepath && $basepath !~ m#/$#;
+

diff --git a/t/snippets/c353.par b/t/snippets/c353.par
new file mode 100644 (file)
index 0000000..0453010
--- /dev/null
+++ b/t/snippets/c353.par
@@ -0,0 +1,2 @@
+--valign-wide-equals
+--valign-if-unless

diff --git a/t/snippets/expect/c353.c353 b/t/snippets/expect/c353.c353
new file mode 100644 (file)
index 0000000..2fee94b
--- /dev/null
+++ b/t/snippets/expect/c353.c353
@@ -0,0 +1,14 @@
+@ns        = split( /, ?/, join( ',', @ns ) );
+@cnames    = split( /, ?/, join( ',', @cnames ) );
+$recurse   = 1       unless ( defined $recurse );
+$port      = 53      unless ( defined $port );
+$srcport   = 0       unless ( defined $srcport );
+$ttl       = 30 * 60 unless ( defined $ttl );
+$hash      = 32      if ( defined $hash && $hash <= 0 );
+$hash      = 63      if ( defined $hash && $hash > 63 );
+$unique    = 1       unless ( defined $hash || defined $unique );
+$unique  ||= $hash   if (1);
+
+$basepath  = $CWD unless length($basepath);
+$basepath .= '/'  if -d $basepath && $basepath !~ m#/$#;
+

diff --git a/t/snippets/expect/c353.def b/t/snippets/expect/c353.def
new file mode 100644 (file)
index 0000000..ac76c4c
--- /dev/null
+++ b/t/snippets/expect/c353.def
@@ -0,0 +1,14 @@
+@ns      = split( /, ?/, join( ',', @ns ) );
+@cnames  = split( /, ?/, join( ',', @cnames ) );
+$recurse = 1       unless ( defined $recurse );
+$port    = 53      unless ( defined $port );
+$srcport = 0       unless ( defined $srcport );
+$ttl     = 30 * 60 unless ( defined $ttl );
+$hash    = 32 if ( defined $hash && $hash <= 0 );
+$hash    = 63 if ( defined $hash && $hash > 63 );
+$unique  = 1 unless ( defined $hash || defined $unique );
+$unique ||= $hash if (1);
+
+$basepath = $CWD unless length($basepath);
+$basepath .= '/' if -d $basepath && $basepath !~ m#/$#;
+

diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt
index 395f7c99d1ef9e2716bbb82e77662defe44b1cef..038440d684104b3a1114b14f2204f75d930ebf90 100644 (file)
--- a/t/snippets/packing_list.txt
+++ b/t/snippets/packing_list.txt
@@ -414,6 +414,7 @@
 ../snippets29.t        git134.def
 ../snippets29.t        git135.def
 ../snippets29.t        git135.git135
+../snippets29.t        c352.def
 ../snippets3.t ce_wn1.ce_wn
 ../snippets3.t ce_wn1.def
 ../snippets3.t colin.colin
@@ -554,4 +555,5 @@
 ../snippets9.t rt98902.def
 ../snippets9.t rt98902.rt98902
 ../snippets9.t rt99961.def
-../snippets29.t        c352.def
+../snippets29.t        c353.c353
+../snippets29.t        c353.def

diff --git a/t/snippets29.t b/t/snippets29.t
index 06538f48f90f5927003252d484cda441bf93a9a3..53e0f5a5de45412a70a1b796150efe5ebf662ae4 100644 (file)
--- a/t/snippets29.t
+++ b/t/snippets29.t
@@ -13,6 +13,8 @@
 #10 git135.def
 #11 git135.git135
 #12 c352.def
+#13 c353.c353
+#14 c353.def
 
 # To locate test #13 you can search for its name or the string '#13'
 
@@ -30,6 +32,10 @@ BEGIN {
     # BEGIN SECTION 1: Parameter combinations #
     ###########################################
     $rparams = {
+        'c353' => <<'----------',
+--valign-wide-equals
+--valign-if-unless
+----------
         'def'  => "",
         'dia1' => "-dia",
         'dia2' => "-aia",
@@ -60,6 +66,23 @@ BEGIN {
                 $text .= filter_blocks( $code, line( substr( $source, 0, $pos[0] ), $line ) ) . ")";
                 print( ( $Pipe->ResizeBuffer($NewSize) == $NewSize ) ? "Successful" : "Unsucessful" ) . "!\n\n";
                 my $func = 'encode_utf8(' . ( !defined $str ? 'undef' : is_utf8($str) ? '$utf8_str' : '$ascii_str' ) . ')';
+----------
+
+        'c353' => <<'----------',
+@ns        = split( /, ?/, join( ',', @ns ) );
+@cnames    = split( /, ?/, join( ',', @cnames ) );
+$recurse   = 1       unless ( defined $recurse );
+$port      = 53      unless ( defined $port );
+$srcport   = 0       unless ( defined $srcport );
+$ttl       = 30 * 60 unless ( defined $ttl );
+$hash      = 32      if ( defined $hash && $hash <= 0 );
+$hash      = 63      if ( defined $hash && $hash > 63 );
+$unique    = 1       unless ( defined $hash || defined $unique );
+$unique  ||= $hash   if (1);
+
+$basepath  = $CWD unless length($basepath);
+$basepath .= '/'  if -d $basepath && $basepath !~ m#/$#;
+
 ----------
 
         'dia' => <<'----------',
@@ -447,6 +470,48 @@ $mask  = ~( ~$mask | $DeadBits{$word} ) if $no_fatal;
                     :                 '$ascii_str' ) . ')';
 #12...........
         },
+
+        'c353.c353' => {
+            source => "c353",
+            params => "c353",
+            expect => <<'#13...........',
+@ns        = split( /, ?/, join( ',', @ns ) );
+@cnames    = split( /, ?/, join( ',', @cnames ) );
+$recurse   = 1       unless ( defined $recurse );
+$port      = 53      unless ( defined $port );
+$srcport   = 0       unless ( defined $srcport );
+$ttl       = 30 * 60 unless ( defined $ttl );
+$hash      = 32      if ( defined $hash && $hash <= 0 );
+$hash      = 63      if ( defined $hash && $hash > 63 );
+$unique    = 1       unless ( defined $hash || defined $unique );
+$unique  ||= $hash   if (1);
+
+$basepath  = $CWD unless length($basepath);
+$basepath .= '/'  if -d $basepath && $basepath !~ m#/$#;
+
+#13...........
+        },
+
+        'c353.def' => {
+            source => "c353",
+            params => "def",
+            expect => <<'#14...........',
+@ns      = split( /, ?/, join( ',', @ns ) );
+@cnames  = split( /, ?/, join( ',', @cnames ) );
+$recurse = 1       unless ( defined $recurse );
+$port    = 53      unless ( defined $port );
+$srcport = 0       unless ( defined $srcport );
+$ttl     = 30 * 60 unless ( defined $ttl );
+$hash    = 32 if ( defined $hash && $hash <= 0 );
+$hash    = 63 if ( defined $hash && $hash > 63 );
+$unique  = 1 unless ( defined $hash || defined $unique );
+$unique ||= $hash if (1);
+
+$basepath = $CWD unless length($basepath);
+$basepath .= '/' if -d $basepath && $basepath !~ m#/$#;
+
+#14...........
+        },
     };
 
     my $ntests = 0 + keys %{$rtests};