Fix undefined var ref involving --format-skipping

diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index d60a4ac05571bf69bb15fea18b6fc178e2fd9451..69d0cdfad73c24720d9a69f61d33b4aff160cabb 100644 (file)
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -5036,7 +5036,6 @@ sub respace_tokens {
     my $is_encoded_data = $self->[_is_encoded_data_];
 
     my $rLL_new = [];    # This is the new array
-    my $KK      = 0;
     my $rtoken_vars;
     my $Ktoken_vars;                   # the old K value of $rtoken_vars
     my ( $Kfirst_old, $Klast_old );    # Range of old line
@@ -5053,10 +5052,9 @@ sub respace_tokens {
     my $cumulative_length = 0;
 
     my %seqno_stack;
-    my %KK_stack;                   # Note: old K index
-    my %K_opening_by_seqno = ();    # Note: old K index
-    my $depth_next         = 0;
-    my $depth_next_max     = 0;
+    my %K_old_opening_by_seqno = ();    # Note: old K index
+    my $depth_next             = 0;
+    my $depth_next_max         = 0;
 
     my $K_closing_container       = $self->[_K_closing_container_];
     my $K_closing_ternary         = $self->[_K_closing_ternary_];
@@ -5129,14 +5127,59 @@ sub respace_tokens {
                 {
                     $rlec_count_by_seqno->{$type_sequence}++;
                 }
+
+                if (   $last_nonblank_type eq '='
+                    || $last_nonblank_type eq '=>' )
+                {
+                    $ris_assigned_structure->{$type_sequence} =
+                      $last_nonblank_type;
+                }
+
+                my $seqno_parent = $seqno_stack{ $depth_next - 1 };
+                $seqno_parent = SEQ_ROOT unless defined($seqno_parent);
+                push @{ $rchildren_of_seqno->{$seqno_parent} }, $type_sequence;
+                $rparent_of_seqno->{$type_sequence}        = $seqno_parent;
+                $seqno_stack{$depth_next}                  = $type_sequence;
+                $K_old_opening_by_seqno{$type_sequence}    = $Ktoken_vars;
+                $depth_next++;
+
+                if ( $depth_next > $depth_next_max ) {
+                    $depth_next_max = $depth_next;
+                }
             }
             elsif ( $is_closing_token{$token} ) {
 
                 $K_closing_container->{$type_sequence} = $KK_new;
-            }
 
-            # These are not yet used but could be useful
+                # Do not include terminal commas in counts
+                if (   $last_nonblank_type eq ','
+                    || $last_nonblank_type eq '=>' )
+                {
+                    my $seqno = $seqno_stack{ $depth_next - 1 };
+                    if ($seqno) {
+                        $rtype_count_by_seqno->{$seqno}->{$last_nonblank_type}
+                          --;
+
+                        if (   $Ktoken_vars == $Kfirst_old
+                            && $last_nonblank_type eq ','
+                            && $rlec_count_by_seqno->{$seqno} )
+                        {
+                            $rlec_count_by_seqno->{$seqno}--;
+                        }
+                    }
+                }
+
+                # Update the stack...
+                $depth_next--;
+            }
             else {
+
+                # For ternary, note parent but do not include as child
+                my $seqno_parent = $seqno_stack{ $depth_next - 1 };
+                $seqno_parent = SEQ_ROOT unless defined($seqno_parent);
+                $rparent_of_seqno->{$type_sequence} = $seqno_parent;
+
+                # These are not yet used but could be useful
                 if ( $token eq '?' ) {
                     $K_opening_ternary->{$type_sequence} = $KK_new;
                 }
@@ -5349,7 +5392,7 @@ sub respace_tokens {
 
             # Go back and see if the corresponding two OPENING tokens are also
             # together.  Note that we are using the OLD K indexing here:
-            my $K_outer_opening = $K_opening_by_seqno{$type_sequence};
+            my $K_outer_opening = $K_old_opening_by_seqno{$type_sequence};
             if ( defined($K_outer_opening) ) {
                 my $K_nxt = $self->K_next_nonblank($K_outer_opening);
                 if ( defined($K_nxt) ) {
@@ -5469,7 +5512,9 @@ sub respace_tokens {
         }
     };
 
-    # Main loop over all lines of the file
+    ############################################
+    # Main loop to respace all lines of the file
+    ############################################
     my $last_K_out;
 
     # Testing option to break qw.  Do not use; it can make a mess.
@@ -5489,6 +5534,9 @@ sub respace_tokens {
         ( $Kfirst_old, $Klast_old ) = ( $Kfirst, $Klast );
         $Klast_old_code = $Klast_old;
 
+        # Be sure an old K value is defined for sub $store_token
+        $Ktoken_vars = $Kfirst;
+
         # Check for correct sequence of token indexes...
         # An error here means that sub write_line() did not correctly
         # package the tokenized lines as it received them.  If we
@@ -5574,6 +5622,7 @@ sub respace_tokens {
 
             # Copy tokens unchanged
             foreach my $KK ( $Kfirst .. $Klast ) {
+                $Ktoken_vars = $KK;
                 $store_token->( $rLL->[$KK] );
             }
             next;
@@ -5646,7 +5695,9 @@ sub respace_tokens {
             }
         }
 
-        # loop to copy all tokens on this line, with any changes
+        ########################################################
+        # Loop to copy all tokens on this line, with any changes
+        ########################################################
         my $type_sequence;
         for ( my $KK = $Kfirst ; $KK <= $Klast ; $KK++ ) {
             $Ktoken_vars = $KK;
@@ -5713,30 +5764,7 @@ sub respace_tokens {
 
             if ($type_sequence) {
 
-                if ( $is_opening_token{$token} ) {
-
-                    if (   $last_nonblank_type eq '='
-                        || $last_nonblank_type eq '=>' )
-                    {
-                        $ris_assigned_structure->{$type_sequence} =
-                          $last_nonblank_type;
-                    }
-
-                    my $seqno_parent = $seqno_stack{ $depth_next - 1 };
-                    $seqno_parent = SEQ_ROOT unless defined($seqno_parent);
-                    push @{ $rchildren_of_seqno->{$seqno_parent} },
-                      $type_sequence;
-                    $rparent_of_seqno->{$type_sequence} = $seqno_parent;
-                    $seqno_stack{$depth_next}           = $type_sequence;
-                    $KK_stack{$depth_next}              = $KK;
-                    $K_opening_by_seqno{$type_sequence} = $KK;
-                    $depth_next++;
-
-                    if ( $depth_next > $depth_next_max ) {
-                        $depth_next_max = $depth_next;
-                    }
-                }
-                elsif ( $is_closing_token{$token} ) {
+                if ( $is_closing_token{$token} ) {
 
                     # Insert a tentative missing semicolon if the next token is
                     # a closing block brace
@@ -5757,36 +5785,6 @@ sub respace_tokens {
                     {
                         $add_phantom_semicolon->($KK);
                     }
-
-                    # Do not include terminal commas in counts
-                    if (   $last_nonblank_type eq ','
-                        || $last_nonblank_type eq '=>' )
-                    {
-                        my $seqno = $seqno_stack{ $depth_next - 1 };
-                        if ($seqno) {
-                            $rtype_count_by_seqno->{$seqno}
-                              ->{$last_nonblank_type}--;
-
-                            if (   $KK == $Kfirst
-                                && $last_nonblank_type eq ','
-                                && $rlec_count_by_seqno->{$seqno} )
-                            {
-                                $rlec_count_by_seqno->{$seqno}--;
-                            }
-                        }
-                    }
-
-                    # Update the stack...  Note that we do this after adding
-                    # any phantom semicolons so that they will be counted in
-                    # the correct container.
-                    $depth_next--;
-                }
-
-                # For ternary, note parent but do not include as child
-                else {
-                    my $seqno_parent = $seqno_stack{ $depth_next - 1 };
-                    $seqno_parent = SEQ_ROOT unless defined($seqno_parent);
-                    $rparent_of_seqno->{$type_sequence} = $seqno_parent;
                 }
             }
 

diff --git a/local-docs/BugLog.pod b/local-docs/BugLog.pod
index 567286e9664488bf8eb6abc7d7425a405c548588..4b874dcd78da0b9569323b38b9ccad82ae64ed10 100644 (file)
--- a/local-docs/BugLog.pod
+++ b/local-docs/BugLog.pod
@@ -2,6 +2,31 @@
 
 =over 4
 
+=item B<Fix undefined var ref involving --format-skipping>
+
+Testing produced a situation in which version 20200625 could cause an undefined
+variable to be accessed (the variable 'Ktoken_vars') as in this snippet:
+
+    #!/usr/bin/perl
+    #<<<
+        my $ra= (
+            [ 'Shine', 40 ], [ 'Specular', [ 1, 1, 0.3, 0 ] ] );
+    #<<<
+    ...
+
+The conditions for this to happen are:
+
+  (1) format skipping (#<<<) begins before the first line of code, and
+  (2) the format skipping section contains the two successive characters ', ['.
+
+The undefined variable was 'Ktoken_vars'.  This problem was introduced by
+commit 21ef53b, an update which fixed case b1100.  This undefined variable
+access does influence the formatted output.
+
+This update fixes this problem.
+
+4 Jul 2021.
+
 =item B<Check for side comment within package statement>
 
 Testing with randomly placed side comments caused perltidy to produce an incorrect