some simplifications and minor optimization

diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm
index 1c78929f90cf7ea982bcb08019558fd151f94b69..4aaa03584d52530ff765106c474e634b25f4c39d 100644 (file)
--- a/lib/Perl/Tidy.pm
+++ b/lib/Perl/Tidy.pm
@@ -3203,16 +3203,14 @@ sub line_diff {
     # differences.
     my $diff_marker = EMPTY_STRING;
     my $pos         = -1;
-    my $pos1        = $pos;
+    my $pos1        = -1;
     if ( defined($s1) && defined($s2) ) {
-        my $count = 0;
-        my $mask  = $s1 ^ $s2;
+        my $mask = $s1 ^ $s2;
 
         while ( $mask =~ /[^\0]/g ) {
-            $count++;
             my $pos_last = $pos;
             $pos = $LAST_MATCH_START[0];
-            if ( $count == 1 ) { $pos1 = $pos; }
+            if ( $pos1 < 0 ) { $pos1 = $pos; }
             $diff_marker .= SPACE x ( $pos - $pos_last - 1 ) . '^';
 
             # we could continue to mark all differences, but there is no point
@@ -3265,7 +3263,8 @@ sub compare_string_buffers {
 
         # lines differ ...
         my ( $line_diff, $pos1 ) = line_diff( $linei, $lineo );
-        my $reason = "Files first differ at character $pos1 of line $counti";
+        my $ch1    = $pos1 + 1;
+        my $reason = "Files first differ at character $ch1 of line $counti";
 
         my ( $leading_ws_i, $leading_ws_o ) = ( EMPTY_STRING, EMPTY_STRING );
         if ( $linei =~ /^(\s+)/ ) { $leading_ws_i = $1; }

diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index 75e2ac82292e5d46f782fa01de1d971553839cf8..3442b2918fb4ed367497d4a5cc1d5169cd663942 100644 (file)
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -1492,37 +1492,29 @@ sub K_next_code {
     # Given:
     #   $KK  = index of the token in $rLL
     #   $rLL = optional array to use (default is $self->[_rLL_])
+
     return if ( !defined($KK) );
     return if ( $KK < 0 );
 
-    # use the standard array unless given otherwise
+    # The optional third arg is useful when we are copying tokens from an old
+    # $rLL to a new $rLL array.
     $rLL = $self->[_rLL_] if ( !defined($rLL) );
-    my $Num  = @{$rLL};
-    my $Knnb = $KK + 1;
-    while ( $Knnb < $Num ) {
-        if ( !defined( $rLL->[$Knnb] ) ) {
-
-            # We seem to have encountered a gap in our array.
-            # This shouldn't happen because sub write_line() pushed
-            # items into the $rLL array.
-            Fault("Undefined entry for k=$Knnb") if (DEVEL_MODE);
-            return;
-        }
-        my $type = $rLL->[$Knnb]->[_TYPE_];
+
+    my $Num = @{$rLL};
+    while ( ++$KK < $Num ) {
+        my $type = $rLL->[$KK]->[_TYPE_];
         if ( $type ne 'b' && $type ne '#' ) {
-            return $Knnb;
+            return $KK;
         }
-        $Knnb++;
-    } ## end while ( $Knnb < $Num )
+    } ## end while ( ++$KK < $Num )
+
     return;
 } ## end sub K_next_code
 
 sub K_next_nonblank {
-
     my ( $self, $KK, $rLL ) = @_;
 
-    # Return the index of the next nonblank token after $KK, or
-    # return undef if none
+    # return the index of the next nonblank token after $KK
     # Given:
     #   $KK  = index of the token in $rLL
     #   $rLL = optional array to use (default is $self->[_rLL_])
@@ -1532,35 +1524,16 @@ sub K_next_nonblank {
     return if ( !defined($KK) );
     return if ( $KK < 0 );
 
-    # The third arg allows this routine to be used on any array.  This is
-    # useful in sub respace_tokens when we are copying tokens from an old $rLL
-    # to a new $rLL array.  But usually the third arg will not be given and we
-    # will just use the $rLL array in $self.
+    # use the standard array unless given otherwise
     $rLL = $self->[_rLL_] if ( !defined($rLL) );
-    my $Num  = @{$rLL};
-    my $Knnb = $KK + 1;
-    return       if ( $Knnb >= $Num );
-    return $Knnb if ( $rLL->[$Knnb]->[_TYPE_] ne 'b' );
-    return       if ( ++$Knnb >= $Num );
-    return $Knnb if ( $rLL->[$Knnb]->[_TYPE_] ne 'b' );
-
-    # Backup loop. Very unlikely to get here; it means we have neighboring
-    # blanks in the token stream.
-    $Knnb++;
-    while ( $Knnb < $Num ) {
-
-        # Safety check, this fault shouldn't happen:  The $rLL array is the
-        # main array of tokens, so all entries should be used.  It is
-        # initialized in sub write_line, and then re-initialized by sub
-        # store_token() within sub respace_tokens.  Tokens are pushed on
-        # so there shouldn't be any gaps.
-        if ( !defined( $rLL->[$Knnb] ) ) {
-            Fault("Undefined entry for k=$Knnb") if (DEVEL_MODE);
-            return;
-        }
-        if ( $rLL->[$Knnb]->[_TYPE_] ne 'b' ) { return $Knnb }
-        $Knnb++;
-    } ## end while ( $Knnb < $Num )
+
+    # Normally, consecutive blanks do not occur. We could test for that
+    # here, but there are checks in the 'store_token' subs.
+    my $Num = @{$rLL};
+    while ( ++$KK < $Num ) {
+        if ( $rLL->[$KK]->[_TYPE_] ne 'b' ) { return $KK }
+    }
+
     return;
 } ## end sub K_next_nonblank
 
@@ -1574,8 +1547,10 @@ sub K_previous_code {
     #   $rLL = optional array to use (default is $self->[_rLL_])
     # Call with $KK=undef to start search at the top of the array
 
-    # use the standard array unless given otherwise
+    # The optional third arg is useful when we are copying tokens from an old
+    # $rLL to a new $rLL array.
     $rLL = $self->[_rLL_] unless ( defined($rLL) );
+
     my $Num = @{$rLL};
     if ( !defined($KK) ) { $KK = $Num }
 
@@ -1584,21 +1559,18 @@ sub K_previous_code {
         # This fault can be caused by a programming error in which a bad $KK is
         # given.  The caller should make the first call with KK_new=undef to
         # avoid this error.
-        Fault(
-"Program Bug: K_previous_nonblank_new called with K=$KK which exceeds $Num"
-        ) if (DEVEL_MODE);
+        if (DEVEL_MODE) {
+            Fault(<<EOM);
+Program Bug: K_previous_nonblank_new called with K=$KK which exceeds $Num
+EOM
+        }
         return;
     }
-    my $Kpnb = $KK - 1;
-    while ( $Kpnb >= 0 ) {
-        my $type = $rLL->[$Kpnb]->[_TYPE_];
-        if (   $type ne 'b'
-            && $type ne '#' )
-        {
-            return $Kpnb;
-        }
-        $Kpnb--;
-    } ## end while ( $Kpnb >= 0 )
+
+    while ( --$KK >= 0 ) {
+        my $type = $rLL->[$KK]->[_TYPE_];
+        if ( $type ne 'b' && $type ne '#' ) { return $KK }
+    }
     return;
 } ## end sub K_previous_code
 
@@ -1606,11 +1578,12 @@ sub K_previous_nonblank {
 
     my ( $self, $KK, $rLL ) = @_;
 
-    # Return index of previous nonblank token before item $KK;
+    # Return the index of the previous nonblank token before $KK
     # Given:
     #   $KK  = index of the token in $rLL
     #   $rLL = optional array to use (default is $self->[_rLL_])
     # Call with $KK=undef to start search at the top of the array
+
     # NOTE: does not skip over the leading type 'q' of a hanging side comment
     # (use K_previous_code)
 
@@ -1618,29 +1591,26 @@ sub K_previous_nonblank {
     $rLL = $self->[_rLL_] unless ( defined($rLL) );
     my $Num = @{$rLL};
     if ( !defined($KK) ) { $KK = $Num }
+
     if ( $KK > $Num ) {
 
         # This fault can be caused by a programming error in which a bad $KK is
         # given.  The caller should make the first call with KK_new=undef to
         # avoid this error.
-        Fault(
-"Program Bug: K_previous_nonblank_new called with K=$KK which exceeds $Num"
-        ) if (DEVEL_MODE);
+        if (DEVEL_MODE) {
+            Fault(<<EOM);
+Program Bug: K_previous_nonblank_new called with K=$KK which exceeds $Num
+EOM
+        }
         return;
     }
-    my $Kpnb = $KK - 1;
-    return       if ( $Kpnb < 0 );
-    return $Kpnb if ( $rLL->[$Kpnb]->[_TYPE_] ne 'b' );
-    return       if ( --$Kpnb < 0 );
-    return $Kpnb if ( $rLL->[$Kpnb]->[_TYPE_] ne 'b' );
 
-    # Backup loop. We should not get here unless some routine
-    # slipped repeated blanks into the token stream.
-    return if ( --$Kpnb < 0 );
-    while ( $Kpnb >= 0 ) {
-        if ( $rLL->[$Kpnb]->[_TYPE_] ne 'b' ) { return $Kpnb }
-        $Kpnb--;
+    # Normally, consecutive blanks do not occur. We could test for that
+    # here, but there are checks in the 'store_token' subs.
+    while ( --$KK >= 0 ) {
+        if ( $rLL->[$KK]->[_TYPE_] ne 'b' ) { return $KK }
     }
+
     return;
 } ## end sub K_previous_nonblank
 
@@ -27042,7 +27012,7 @@ EOM
         # Loop over all sub-sections.  Note that we have to work backwards
         # from the end of the batch since the sections use original line
         # numbers, and the line numbers change as we go.
-        while ( my $section = pop @{$rsections} ) {
+        foreach my $section ( reverse @{$rsections} ) {
             my ( $nbeg, $nend ) = @{$section};
             $self->recombine_section_loop(
                 {