File Manager - BorneoXploit

Editing: VerticalAligner.pm

package Perl::Tidy::VerticalAligner;
use strict;
use warnings;
use Carp;

{ #<<< A non-indenting brace to contain all lexical variables

our $VERSION = '20240511';
use English qw( -no_match_vars );
use Scalar::Util 'refaddr';
use Perl::Tidy::VerticalAligner::Alignment;
use Perl::Tidy::VerticalAligner::Line;

use constant DEVEL_MODE   => 0;
use constant EMPTY_STRING => q{};
use constant SPACE        => q{ };

# The Perl::Tidy::VerticalAligner package collects output lines and
# attempts to line up certain common tokens, such as => and #, which are
# identified by the calling routine.
#
# Usage:
#   - Initiate an object with a call to new().
#   - Write lines one-by-one with calls to valign_input().
#   - Make a final call to flush() to empty the pipeline.
#
# The sub valign_input collects lines into groups.  When a group reaches
# the maximum possible size it is processed for alignment and output.
# The maximum group size is reached whenever there is a change in indentation
# level, a blank line, a block comment, or an external flush call.  The calling
# routine may also force a break in alignment at any time.
#
# If the calling routine needs to interrupt the output and send other text to
# the output, it must first call flush() to empty the output pipeline.  This
# might occur for example if a block of pod text needs to be sent to the output
# between blocks of code.

# It is essential that a final call to flush() be made. Otherwise some
# final lines of text will be lost.

# Index...
# CODE SECTION 1: Preliminary code, global definitions and sub new
#                 sub new
# CODE SECTION 2: Some Basic Utilities
# CODE SECTION 3: Code to accept input and form groups
#                 sub valign_input
# CODE SECTION 4: Code to process comment lines
#                 sub _flush_comment_lines
# CODE SECTION 5: Code to process groups of code lines
#                 sub _flush_group_lines
# CODE SECTION 6: Pad Signed Number Columns
#                 sub pad_signed_number_columns
# CODE SECTION 7: Pad Wide Equals Columns
#                 sub pad_wide_equals_columns
# CODE SECTION 8: Output Step A
#                 sub valign_output_step_A
# CODE SECTION 9: Output Step B
#                 sub valign_output_step_B
# CODE SECTION 10: Output Step C
#                 sub valign_output_step_C
# CODE SECTION 11: Output Step D
#                 sub valign_output_step_D
# CODE SECTION 12: Summary
#                 sub report_anything_unusual

##################################################################
# CODE SECTION 1: Preliminary code, global definitions and sub new
##################################################################

sub AUTOLOAD {

# Catch any undefined sub calls so that we are sure to get
    # some diagnostic information.  This sub should never be called
    # except for a programming error.
    our $AUTOLOAD;
    return if ( $AUTOLOAD =~ /\bDESTROY$/ );
    my ( $pkg, $fname, $lno ) = caller();
    my $my_package = __PACKAGE__;
    print {*STDERR} <<EOM;
======================================================================
Error detected in package '$my_package', version $VERSION
Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
Called from package: '$pkg'
Called from File '$fname'  at line '$lno'
This error is probably due to a recent programming change
======================================================================
EOM
    exit 1;
} ## end sub AUTOLOAD

sub DESTROY {

# required to avoid call to AUTOLOAD in some versions of perl
}

sub Die {
    my ($msg) = @_;
    Perl::Tidy::Die($msg);
    croak "unexpected return from Perl::Tidy::Die";
}

sub Fault {
    my ($msg) = @_;

# This routine is called for errors that really should not occur
    # except if there has been a bug introduced by a recent program change.
    # Please add comments at calls to Fault to explain why the call
    # should not occur, and where to look to fix it.
    my ( $package0, $filename0, $line0, $subroutine0 ) = caller(0);
    my ( $package1, $filename1, $line1, $subroutine1 ) = caller(1);
    my ( $package2, $filename2, $line2, $subroutine2 ) = caller(2);
    my $pkg = __PACKAGE__;

my $input_stream_name = get_input_stream_name();

Die(<<EOM);
==============================================================================
While operating on input stream with name: '$input_stream_name'
A fault was detected at line $line0 of sub '$subroutine1'
in file '$filename1'
which was called from line $line1 of sub '$subroutine2'
Message: '$msg'
This is probably an error introduced by a recent programming change.
$pkg reports VERSION='$VERSION'.
==============================================================================
EOM

# We shouldn't get here, but this return is to keep Perl-Critic from
    # complaining.
    return;
} ## end sub Fault

my %valid_LINE_keys;

BEGIN {

# define valid keys in a line object
    my @q = qw(
      jmax
      rtokens
      rfields
      rfield_lengths
      rpatterns
      indentation
      leading_space_count
      outdent_long_lines
      list_type
      list_seqno
      is_hanging_side_comment
      maximum_line_length
      rvertical_tightness_flags
      is_terminal_ternary
      j_terminal_match
      end_group
      Kend
      ci_level
      level
      level_end
      imax_pair

ralignments
    );

@valid_LINE_keys{@q} = (1) x scalar(@q);
} ## end BEGIN

BEGIN {

# Define the fixed indexes for variables in $self, which is an array
    # reference.  Note the convention of leading and trailing underscores to
    # keep them unique.
    # Do not combine with other BEGIN blocks (c101).
    my $i = 0;
    use constant {
        _file_writer_object_ => $i++,
        _logger_object_      => $i++,
        _diagnostics_object_ => $i++,

_rOpts_ => $i++,

_last_level_written_            => $i++,
        _last_side_comment_column_      => $i++,
        _last_side_comment_line_number_ => $i++,
        _last_side_comment_length_      => $i++,
        _last_side_comment_level_       => $i++,
        _outdented_line_count_          => $i++,
        _first_outdented_line_at_       => $i++,
        _last_outdented_line_at_        => $i++,
        _consecutive_block_comments_    => $i++,

_rgroup_lines_                => $i++,
        _group_level_                 => $i++,
        _group_type_                  => $i++,
        _group_maximum_line_length_   => $i++,
        _zero_count_                  => $i++,
        _last_leading_space_count_    => $i++,
        _comment_leading_space_count_ => $i++,
    };

# Debug flag. This is a relic from the original program development
    # looking for problems with tab characters.  Caution: this debug flag can
    # produce a lot of output It should be 0 except when debugging small
    # scripts.

use constant DEBUG_TABS => 0;

my $debug_warning = sub {
        my $msg = shift;
        print {*STDOUT} "VALIGN_DEBUGGING with key $msg\n";
        return;
    };

DEBUG_TABS && $debug_warning->('TABS');
} ## end BEGIN

# GLOBAL variables
my (

%valign_control_hash,
    $valign_control_default,

$rOpts_indent_columns,
    $rOpts_tabs,
    $rOpts_entab_leading_whitespace,
    $rOpts_fixed_position_side_comment,
    $rOpts_maximum_line_length,
    $rOpts_minimum_space_to_comment,
    $rOpts_valign_code,
    $rOpts_valign_block_comments,
    $rOpts_valign_side_comments,
    $rOpts_valign_signed_numbers,
    $rOpts_valign_signed_numbers_limit,
    $rOpts_valign_wide_equals,

$require_tabs,

);

sub check_options {

# This routine is called to check the user-supplied run parameters
    # and to configure the control hashes to them.
    my ($rOpts) = @_;

# All alignments are done by default
    %valign_control_hash    = ();
    $valign_control_default = 1;

# If -vil=s is entered without -vxl, assume -vxl='*'
    if (  !$rOpts->{'valign-exclusion-list'}
        && $rOpts->{'valign-inclusion-list'} )
    {
        $rOpts->{'valign-exclusion-list'} = '*';
    }

# See if the user wants to exclude any alignment types ...
    if ( $rOpts->{'valign-exclusion-list'} ) {

# The inclusion list is only relevant if there is an exclusion list
        if ( $rOpts->{'valign-inclusion-list'} ) {
            my @vil = split /\s+/, $rOpts->{'valign-inclusion-list'};
            @valign_control_hash{@vil} = (1) x scalar(@vil);
        }

# Note that the -vxl list is done after -vil, so -vxl has priority
        # in the event of duplicate entries.
        my @vxl = split /\s+/, $rOpts->{'valign-exclusion-list'};
        @valign_control_hash{@vxl} = (0) x scalar(@vxl);

# Optimization: revert to defaults if no exclusions.
        # This could happen with -vxl='  ' and any -vil list
        if ( !@vxl ) {
            %valign_control_hash = ();
        }

# '$valign_control_default' applies to types not in the hash:
        # - If a '*' was entered then set it to be that default type
        # - Otherwise, leave it set it to 1
        if ( defined( $valign_control_hash{'*'} ) ) {
            $valign_control_default = $valign_control_hash{'*'};
        }

# Side comments are controlled separately and must be removed
        # if given in a list.
        if (%valign_control_hash) {
            $valign_control_hash{'#'} = 1;
        }
    }

# Initialize some global options
    $rOpts_indent_columns           = $rOpts->{'indent-columns'};
    $rOpts_tabs                     = $rOpts->{'tabs'};
    $rOpts_entab_leading_whitespace = $rOpts->{'entab-leading-whitespace'};
    $require_tabs = ( $rOpts_tabs || $rOpts_entab_leading_whitespace )
      && $rOpts_indent_columns > 0;

$rOpts_fixed_position_side_comment =
      $rOpts->{'fixed-position-side-comment'};

$rOpts_maximum_line_length      = $rOpts->{'maximum-line-length'};
    $rOpts_minimum_space_to_comment = $rOpts->{'minimum-space-to-comment'};
    $rOpts_valign_code              = $rOpts->{'valign-code'};
    $rOpts_valign_block_comments    = $rOpts->{'valign-block-comments'};
    $rOpts_valign_side_comments     = $rOpts->{'valign-side-comments'};
    $rOpts_valign_signed_numbers    = $rOpts->{'valign-signed-numbers'};
    $rOpts_valign_signed_numbers_limit =
      $rOpts->{'valign-signed-numbers-limit'};
    $rOpts_valign_wide_equals = $rOpts->{'valign-wide-equals'};

return;
} ## end sub check_options

sub check_keys {
    my ( $rtest, $rvalid, $msg, $exact_match ) = @_;

# Check the keys of a hash:
    # $rtest   = ref to hash to test
    # $rvalid  = ref to hash with valid keys

# $msg = a message to write in case of error
    # $exact_match defines the type of check:
    #     = false: test hash must not have unknown key
    #     = true:  test hash must have exactly same keys as known hash
    my @unknown_keys =
      grep { !exists $rvalid->{$_} } keys %{$rtest};
    my @missing_keys =
      grep { !exists $rtest->{$_} } keys %{$rvalid};
    my $error = @unknown_keys;
    if ($exact_match) { $error ||= @missing_keys }
    if ($error) {
        local $LIST_SEPARATOR = ')(';
        my @expected_keys = sort keys %{$rvalid};
        @unknown_keys = sort @unknown_keys;
        Fault(<<EOM);
------------------------------------------------------------------------
Program error detected checking hash keys
Message is: '$msg'
Expected keys: (@expected_keys)
Unknown key(s): (@unknown_keys)
Missing key(s): (@missing_keys)
------------------------------------------------------------------------
EOM
    }
    return;
} ## end sub check_keys

sub new {

my ( $class, @arglist ) = @_;
    if ( @arglist % 2 ) { croak "Odd number of items in arg hash list\n" }

my %defaults = (
        rOpts              => undef,
        file_writer_object => undef,
        logger_object      => undef,
        diagnostics_object => undef,
    );
    my %args = ( %defaults, @arglist );

# Initialize other caches and buffers
    initialize_step_B_cache();
    initialize_valign_buffer();
    initialize_decode();
    set_logger_object( $args{logger_object} );

# Initialize all variables in $self.
    # To add an item to $self, first define a new constant index in the BEGIN
    # section.
    my $self = [];

# objects
    $self->[_file_writer_object_] = $args{file_writer_object};
    $self->[_logger_object_]      = $args{logger_object};
    $self->[_diagnostics_object_] = $args{diagnostics_object};

# shortcut to user options
    my $rOpts = $args{rOpts};
    $self->[_rOpts_] = $rOpts;

# Batch of lines being collected
    $self->[_rgroup_lines_]                = [];
    $self->[_group_level_]                 = 0;
    $self->[_group_type_]                  = EMPTY_STRING;
    $self->[_group_maximum_line_length_]   = undef;
    $self->[_zero_count_]                  = 0;
    $self->[_comment_leading_space_count_] = 0;
    $self->[_last_leading_space_count_]    = 0;

# Memory of what has been processed
    $self->[_last_level_written_]            = -1;
    $self->[_last_side_comment_column_]      = 0;
    $self->[_last_side_comment_line_number_] = 0;
    $self->[_last_side_comment_length_]      = 0;
    $self->[_last_side_comment_level_]       = -1;
    $self->[_outdented_line_count_]          = 0;
    $self->[_first_outdented_line_at_]       = 0;
    $self->[_last_outdented_line_at_]        = 0;
    $self->[_consecutive_block_comments_]    = 0;

bless $self, $class;
    return $self;
} ## end sub new

#################################
# CODE SECTION 2: Basic Utilities
#################################

sub flush {

# flush() is the external call to completely empty the pipeline.
    my ($self) = @_;

# push things out the pipeline...

# push out any current group lines
    $self->_flush_group_lines()
      if ( @{ $self->[_rgroup_lines_] } );

# then anything left in the cache of step_B
    $self->_flush_step_B_cache();

# then anything left in the buffer of step_C
    $self->dump_valign_buffer();

return;
} ## end sub flush

sub initialize_for_new_group {
    my ($self) = @_;

$self->[_rgroup_lines_]                = [];
    $self->[_group_type_]                  = EMPTY_STRING;
    $self->[_zero_count_]                  = 0;
    $self->[_comment_leading_space_count_] = 0;
    $self->[_last_leading_space_count_]    = 0;
    $self->[_group_maximum_line_length_]   = undef;

# Note that the value for _group_level_ is
    # handled separately in sub valign_input
    return;
} ## end sub initialize_for_new_group

sub group_line_count {
    my $self = shift;
    return +@{ $self->[_rgroup_lines_] };
}

# interface to Perl::Tidy::Diagnostics routines
# For debugging; not currently used
sub write_diagnostics {
    my ( $self, $msg ) = @_;
    my $diagnostics_object = $self->[_diagnostics_object_];
    if ($diagnostics_object) {
        $diagnostics_object->write_diagnostics($msg);
    }
    return;
} ## end sub write_diagnostics

{    ## begin closure for logger routines
    my $logger_object;

# Called once per file to initialize the logger object
    sub set_logger_object {
        $logger_object = shift;
        return;
    }

sub get_input_stream_name {
        my $input_stream_name = EMPTY_STRING;
        if ($logger_object) {
            $input_stream_name = $logger_object->get_input_stream_name();
        }
        return $input_stream_name;
    } ## end sub get_input_stream_name

sub warning {
        my ($msg) = @_;
        if ($logger_object) {
            $logger_object->warning($msg);
        }
        return;
    } ## end sub warning

sub write_logfile_entry {
        my ($msg) = @_;
        if ($logger_object) {
            $logger_object->write_logfile_entry($msg);
        }
        return;
    } ## end sub write_logfile_entry
}

sub get_cached_line_count {
    my $self = shift;
    return $self->group_line_count() + ( get_cached_line_type() ? 1 : 0 );
}

sub get_recoverable_spaces {

# return the number of spaces (+ means shift right, - means shift left)
    # that we would like to shift a group of lines with the same indentation
    # to get them to line up with their opening parens
    my $indentation = shift;
    return ref($indentation) ? $indentation->get_recoverable_spaces() : 0;
} ## end sub get_recoverable_spaces

######################################################
# CODE SECTION 3: Code to accept input and form groups
######################################################

use constant DEBUG_VALIGN      => 0;
use constant SC_LONG_LINE_DIFF => 12;

my %is_closing_token;

BEGIN {
    my @q = qw< } ) ] >;
    @is_closing_token{@q} = (1) x scalar(@q);
}

#--------------------------------------------
# VTFLAGS: Vertical tightness types and flags
#--------------------------------------------
# Vertical tightness is controlled by a 'type' and associated 'flags' for each
# line.  These values are set by sub Formatter::set_vertical_tightness_flags.
# These are defined as follows:

# Vertical Tightness Line Type Codes:
# Type 0, no vertical tightness condition
# Type 1, last token of this line is a non-block opening token
# Type 2, first token of next line is a non-block closing
# Type 3, isolated opening block brace
# type 4, isolated closing block brace

# Opening token flag values are the vertical tightness flags
# 0 do not join with next line
# 1 just one join per line
# 2 any number of joins

# Closing token flag values indicate spacing:
# 0 = no space added before closing token
# 1 = single space added before closing token

sub valign_input {

#---------------------------------------------------------------------
    # This is the front door of the vertical aligner.  On each call
    # we receive one line of specially marked text for vertical alignment.
    # We compare the line with the current group, and either:
    # - the line joins the current group if alignments match, or
    # - the current group is flushed and a new group is started
    #---------------------------------------------------------------------
    #
    # The key input parameters describing each line are:
    #     $level          = indentation level of this line
    #     $rfields        = ref to array of fields
    #     $rpatterns      = ref to array of patterns, one per field
    #     $rtokens        = ref to array of tokens starting fields 1,2,..
    #     $rfield_lengths = ref to array of field display widths
    #
    # Here is an example of what this package does.  In this example,
    # we are trying to line up both the '=>' and the '#'.
    #
    #         '18' => 'grave',    #   \`
    #         '19' => 'acute',    #   `'
    #         '20' => 'caron',    #   \v
    # <-tabs-><f1-><--field 2 ---><-f3->
    # |            |              |    |
    # |            |              |    |
    # col1        col2         col3 col4
    #
    # The calling routine has already broken the entire line into 3 fields as
    # indicated.  (So the work of identifying promising common tokens has
    # already been done).
    #
    # In this example, there will be 2 tokens being matched: '=>' and '#'.
    # They are the leading parts of fields 2 and 3, but we do need to know
    # what they are so that we can dump a group of lines when these tokens
    # change.
    #
    # The fields contain the actual characters of each field.  The patterns
    # are like the fields, but they contain mainly token types instead
    # of tokens, so they have fewer characters.  They are used to be
    # sure we are matching fields of similar type.
    #
    # In this example, there will be 4 column indexes being adjusted.  The
    # first one is always at zero.  The interior columns are at the start of
    # the matching tokens, and the last one tracks the maximum line length.
    #
    # Each time a new line comes in, it joins the current vertical
    # group if possible.  Otherwise it causes the current group to be flushed
    # and a new group is started.
    #
    # For each new group member, the column locations are increased, as
    # necessary, to make room for the new fields.  When the group is finally
    # output, these column numbers are used to compute the amount of spaces of
    # padding needed for each field.
    #
    # Programming note: the fields are assumed not to have any tab characters.
    # Tabs have been previously removed except for tabs in quoted strings and
    # side comments.  Tabs in these fields can mess up the column counting.
    # The log file warns the user if there are any such tabs.

my ( $self, $rcall_hash ) = @_;

# Unpack the call args. This form is significantly faster than getting them
    # one-by-one.
    my (

$Kend,
        $break_alignment_after,
        $break_alignment_before,
        $ci_level,
        $forget_side_comment,
        $indentation,
        $is_terminal_ternary,
        $level,
        $level_end,
        $list_seqno,
        $maximum_line_length,
        $outdent_long_lines,
        $rline_alignment,
        $rvertical_tightness_flags,

) =

@{$rcall_hash}{
        qw(
          Kend
          break_alignment_after
          break_alignment_before
          ci_level
          forget_side_comment
          indentation
          is_terminal_ternary
          level
          level_end
          list_seqno
          maximum_line_length
          outdent_long_lines
          rline_alignment
          rvertical_tightness_flags
        )
      };

my ( $rtokens, $rfields, $rpatterns, $rfield_lengths ) =
      @{$rline_alignment};

# The index '$Kend' is a value which passed along with the line text to sub
    # 'write_code_line' for a convergence check.

# number of fields is $jmax
    # number of tokens between fields is $jmax-1
    my $jmax = @{$rfields} - 1;

my $leading_space_count =
      ref($indentation) ? $indentation->get_spaces() : $indentation;

# set outdented flag to be sure we either align within statements or
    # across statement boundaries, but not both.
    my $is_outdented =
      $self->[_last_leading_space_count_] > $leading_space_count;
    $self->[_last_leading_space_count_] = $leading_space_count;

# Identify a hanging side comment.  Hanging side comments have an empty
    # initial field.
    my $is_hanging_side_comment =
      ( $jmax == 1 && $rtokens->[0] eq '#' && $rfields->[0] =~ /^\s*$/ );

# Undo outdented flag for a hanging side comment
    $is_outdented = 0 if $is_hanging_side_comment;

# Identify a block comment.
    my $is_block_comment = $jmax == 0 && substr( $rfields->[0], 0, 1 ) eq '#';

# Block comment .. update count
    if ($is_block_comment) {
        $self->[_consecutive_block_comments_]++;
    }

# Not a block comment ..
    # Forget side comment column if we saw 2 or more block comments,
    # and reset the count
    else {

if ( $self->[_consecutive_block_comments_] > 1 ) {
            $self->forget_side_comment();
        }
        $self->[_consecutive_block_comments_] = 0;
    }

# Reset side comment location if we are entering a new block from level 0.
    # This is intended to keep them from drifting too far to the right.
    if ($forget_side_comment) {
        $self->forget_side_comment();
    }

my $is_balanced_line = $level_end == $level;

my $group_level               = $self->[_group_level_];
    my $group_maximum_line_length = $self->[_group_maximum_line_length_];

DEBUG_VALIGN && do {
        my $nlines = $self->group_line_count();
        print {*STDOUT}
"Entering valign_input: lines=$nlines new #fields= $jmax, leading_count=$leading_space_count, level=$level, group_level=$group_level, level_end=$level_end\n";
    };

# Validate cached line if necessary: If we can produce a container
    # with just 2 lines total by combining an existing cached opening
    # token with the closing token to follow, then we will mark both
    # cached flags as valid.
    my $cached_line_type = get_cached_line_type();
    if ($cached_line_type) {
        my $cached_line_opening_flag = get_cached_line_opening_flag();
        if ($rvertical_tightness_flags) {
            my $cached_seqno = get_cached_seqno();
            if (   $cached_seqno
                && $rvertical_tightness_flags->{_vt_seqno}
                && $rvertical_tightness_flags->{_vt_seqno} == $cached_seqno )
            {

# Fix for b1187 and b1188: Normally this step is only done
                # if the number of existing lines is 0 or 1.  But to prevent
                # blinking, this range can be controlled by the caller.
                # If zero values are given we fall back on the range 0 to 1.
                my $line_count = $self->group_line_count();
                my $min_lines  = $rvertical_tightness_flags->{_vt_min_lines};
                my $max_lines  = $rvertical_tightness_flags->{_vt_max_lines};
                $min_lines = 0 if ( !$min_lines );
                $max_lines = 1 if ( !$max_lines );
                if (   ( $line_count >= $min_lines )
                    && ( $line_count <= $max_lines ) )
                {
                    $rvertical_tightness_flags->{_vt_valid_flag} ||= 1;
                    set_cached_line_valid(1);
                }
            }
        }

# do not join an opening block brace (type 3, see VTFLAGS)
        # with an unbalanced line unless requested with a flag value of 2
        if (   $cached_line_type == 3
            && !$self->group_line_count()
            && $cached_line_opening_flag < 2
            && !$is_balanced_line )
        {
            set_cached_line_valid(0);
        }
    }

# shouldn't happen:
    if ( $level < 0 ) { $level = 0 }

# do not align code across indentation level changes
    # or changes in the maximum line length
    # or if vertical alignment is turned off
    if (
        $level != $group_level
        || (   $group_maximum_line_length
            && $maximum_line_length != $group_maximum_line_length )
        || $is_outdented
        || ( $is_block_comment && !$rOpts_valign_block_comments )
        || (   !$is_block_comment
            && !$rOpts_valign_side_comments
            && !$rOpts_valign_code )
      )
    {

$self->_flush_group_lines( $level - $group_level )
          if ( @{ $self->[_rgroup_lines_] } );

$group_level                         = $level;
        $self->[_group_level_]               = $group_level;
        $self->[_group_maximum_line_length_] = $maximum_line_length;

# Update leading spaces after the above flush because the leading space
        # count may have been changed if the -icp flag is in effect
        $leading_space_count =
          ref($indentation) ? $indentation->get_spaces() : $indentation;
    }

# --------------------------------------------------------------------
    # Collect outdentable block COMMENTS
    # --------------------------------------------------------------------
    if ( $self->[_group_type_] eq 'COMMENT' ) {
        if (   $is_block_comment
            && $outdent_long_lines
            && $leading_space_count == $self->[_comment_leading_space_count_] )
        {

# Note that for a comment group we are not storing a line
            # but rather just the text and its length.
            push @{ $self->[_rgroup_lines_] },
              [ $rfields->[0], $rfield_lengths->[0], $Kend ];
            return;
        }
        else {
            $self->_flush_group_lines()
              if ( @{ $self->[_rgroup_lines_] } );
        }
    }

my $rgroup_lines = $self->[_rgroup_lines_];
    if ( $break_alignment_before && @{$rgroup_lines} ) {
        $rgroup_lines->[-1]->{'end_group'} = 1;
    }

# --------------------------------------------------------------------
    # add dummy fields for terminal ternary
    # --------------------------------------------------------------------
    my $j_terminal_match;

if ( $is_terminal_ternary && @{$rgroup_lines} ) {
        $j_terminal_match = fix_terminal_ternary(
            {
                old_line       => $rgroup_lines->[-1],
                rfields        => $rfields,
                rtokens        => $rtokens,
                rpatterns      => $rpatterns,
                rfield_lengths => $rfield_lengths,
                group_level    => $group_level,
            }
        );
        $jmax = @{$rfields} - 1;
    }

# --------------------------------------------------------------------
    # add dummy fields for else statement
    # --------------------------------------------------------------------

# Note the trailing space after 'else' here. If there were no space between
    # the else and the next '{' then we would not be able to do vertical
    # alignment of the '{'.
    if (   $rfields->[0] eq 'else '
        && @{$rgroup_lines}
        && $is_balanced_line )
    {
        $j_terminal_match = fix_terminal_else(
            {
                old_line       => $rgroup_lines->[-1],
                rfields        => $rfields,
                rtokens        => $rtokens,
                rpatterns      => $rpatterns,
                rfield_lengths => $rfield_lengths,
            }
        );
        $jmax = @{$rfields} - 1;
    }

# --------------------------------------------------------------------
    # Handle simple line of code with no fields to match.
    # --------------------------------------------------------------------
    if ( $jmax <= 0 ) {
        $self->[_zero_count_]++;

# VSN PATCH for a single number, part 1.
        my $is_numeric =
          $rOpts_valign_signed_numbers && $rpatterns->[0] eq 'n,';

if (   !$is_numeric
            && @{$rgroup_lines}
            && !get_recoverable_spaces( $rgroup_lines->[0]->{'indentation'} ) )
        {

# flush the current group if it has some aligned columns..
            # or we haven't seen a comment lately
            if (   $rgroup_lines->[0]->{'jmax'} > 1
                || $self->[_zero_count_] > 3 )
            {
                $self->_flush_group_lines()
                  if ( @{ $self->[_rgroup_lines_] } );

# Update '$rgroup_lines' - it will become a ref to empty array.
                # This allows avoiding a call to get_group_line_count below.
                $rgroup_lines = $self->[_rgroup_lines_];
            }
        }

# start new COMMENT group if this comment may be outdented
        if (   $is_block_comment
            && $outdent_long_lines
            && !@{$rgroup_lines} )
        {
            $self->[_group_type_]                  = 'COMMENT';
            $self->[_comment_leading_space_count_] = $leading_space_count;
            $self->[_group_maximum_line_length_]   = $maximum_line_length;
            push @{$rgroup_lines},
              [ $rfields->[0], $rfield_lengths->[0], $Kend ];
            return;
        }

# just write this line directly if no current group, no side comment,
        # and no space recovery is needed,
        # and not numeric - VSN PATCH for a single number, part 4.
        if (   !@{$rgroup_lines}
            && !$is_numeric
            && !get_recoverable_spaces($indentation) )
        {

$self->valign_output_step_B(
                {
                    leading_space_count       => $leading_space_count,
                    line                      => $rfields->[0],
                    line_length               => $rfield_lengths->[0],
                    side_comment_length       => 0,
                    outdent_long_lines        => $outdent_long_lines,
                    rvertical_tightness_flags => $rvertical_tightness_flags,
                    level                     => $level,
                    level_end                 => $level_end,
                    Kend                      => $Kend,
                    maximum_line_length       => $maximum_line_length,
                }
            );
            return;
        }
    }
    else {
        $self->[_zero_count_] = 0;
    }

# --------------------------------------------------------------------
    # It simplifies things to create a zero length side comment
    # if none exists.
    # --------------------------------------------------------------------
    if ( ( $jmax == 0 ) || ( $rtokens->[ $jmax - 1 ] ne '#' ) ) {
        $jmax += 1;
        $rtokens->[ $jmax - 1 ]  = '#';
        $rfields->[$jmax]        = EMPTY_STRING;
        $rfield_lengths->[$jmax] = 0;
        $rpatterns->[$jmax]      = '#';
    }

# --------------------------------------------------------------------
    # create an object to hold this line
    # --------------------------------------------------------------------

# The hash keys below must match the list of keys in %valid_LINE_keys.
    # Values in this hash are accessed directly, except for 'ralignments',
    # rather than with get/set calls for efficiency.
    my $new_line = Perl::Tidy::VerticalAligner::Line->new(
        {
            jmax                      => $jmax,
            rtokens                   => $rtokens,
            rfields                   => $rfields,
            rpatterns                 => $rpatterns,
            rfield_lengths            => $rfield_lengths,
            indentation               => $indentation,
            leading_space_count       => $leading_space_count,
            outdent_long_lines        => $outdent_long_lines,
            list_seqno                => $list_seqno,
            list_type                 => EMPTY_STRING,
            is_hanging_side_comment   => $is_hanging_side_comment,
            rvertical_tightness_flags => $rvertical_tightness_flags,
            is_terminal_ternary       => $is_terminal_ternary,
            j_terminal_match          => $j_terminal_match,
            end_group                 => $break_alignment_after,
            Kend                      => $Kend,
            ci_level                  => $ci_level,
            level                     => $level,
            level_end                 => $level_end,
            imax_pair                 => -1,
            maximum_line_length       => $maximum_line_length,

ralignments => [],
        }
    );

DEVEL_MODE
      && check_keys( $new_line, \%valid_LINE_keys,
        "Checking line keys at line definition", 1 );

# --------------------------------------------------------------------
    # Decide if this is a simple list of items.
    # We use this to be less restrictive in deciding what to align.
    # --------------------------------------------------------------------
    decide_if_list($new_line) if ($list_seqno);

# --------------------------------------------------------------------
    # Append this line to the current group (or start new group)
    # --------------------------------------------------------------------

push @{ $self->[_rgroup_lines_] }, $new_line;
    $self->[_group_maximum_line_length_] = $maximum_line_length;

# output this group if it ends in a terminal else or ternary line
    if ( defined($j_terminal_match) ) {
        $self->_flush_group_lines()
          if ( @{ $self->[_rgroup_lines_] } );
    }

# Force break after jump to lower level
    elsif ($level_end < $level
        || $is_closing_token{ substr( $rfields->[0], 0, 1 ) } )
    {
        $self->_flush_group_lines(-1)
          if ( @{ $self->[_rgroup_lines_] } );
    }

else {
        ##ok: no output needed
    }

# --------------------------------------------------------------------
    # Some old debugging stuff
    # --------------------------------------------------------------------
    DEBUG_VALIGN && do {
        print {*STDOUT} "exiting valign_input fields:";
        dump_array( @{$rfields} );
        print {*STDOUT} "exiting valign_input tokens:";
        dump_array( @{$rtokens} );
        print {*STDOUT} "exiting valign_input patterns:";
        dump_array( @{$rpatterns} );
    };

return;
} ## end sub valign_input

sub join_hanging_comment {

# Add dummy fields to a hanging side comment to make it look
    # like the first line in its potential group.  This simplifies
    # the coding.
    my ( $new_line, $old_line ) = @_;

my $jmax = $new_line->{'jmax'};

# must be 2 fields
    return 0 unless ( $jmax == 1 );
    my $rtokens = $new_line->{'rtokens'};

# the second field must be a comment
    return 0 unless ( $rtokens->[0] eq '#' );
    my $rfields = $new_line->{'rfields'};

# the first field must be empty
    return 0 if ( $rfields->[0] !~ /^\s*$/ );

# the current line must have fewer fields
    my $maximum_field_index = $old_line->{'jmax'};
    return 0
      if ( $maximum_field_index <= $jmax );

# looks ok..
    my $rpatterns      = $new_line->{'rpatterns'};
    my $rfield_lengths = $new_line->{'rfield_lengths'};

$new_line->{'is_hanging_side_comment'} = 1;

$jmax                     = $maximum_field_index;
    $new_line->{'jmax'}       = $jmax;
    $rfields->[$jmax]         = $rfields->[1];
    $rfield_lengths->[$jmax]  = $rfield_lengths->[1];
    $rtokens->[ $jmax - 1 ]   = $rtokens->[0];
    $rpatterns->[ $jmax - 1 ] = $rpatterns->[0];

foreach my $j ( 1 .. $jmax - 1 ) {
        $rfields->[$j]         = EMPTY_STRING;
        $rfield_lengths->[$j]  = 0;
        $rtokens->[ $j - 1 ]   = EMPTY_STRING;
        $rpatterns->[ $j - 1 ] = EMPTY_STRING;
    }
    return 1;
} ## end sub join_hanging_comment

{    ## closure for sub decide_if_list

my %is_comma_token;

BEGIN {

my @q = qw( => );
        push @q, ',';
        @is_comma_token{@q} = (1) x scalar(@q);
    } ## end BEGIN

sub decide_if_list {

my $line = shift;

# A list will be taken to be a line with a forced break in which all
        # of the field separators are commas or comma-arrows (except for the
        # trailing #)

my $rtokens    = $line->{'rtokens'};
        my $test_token = $rtokens->[0];
        my ( $raw_tok, $lev, $tag, $tok_count ) =
          decode_alignment_token($test_token);
        if ( $is_comma_token{$raw_tok} ) {
            my $list_type = $test_token;
            my $jmax      = $line->{'jmax'};

foreach ( 1 .. $jmax - 2 ) {
                ( $raw_tok, $lev, $tag, $tok_count ) =
                  decode_alignment_token( $rtokens->[$_] );
                if ( !$is_comma_token{$raw_tok} ) {
                    $list_type = EMPTY_STRING;
                    last;
                }
            }
            $line->{'list_type'} = $list_type;
        }
        return;
    } ## end sub decide_if_list
}

sub fix_terminal_ternary {

# Add empty fields as necessary to align a ternary term
    # like this:
    #
    #  my $leapyear =
    #      $year % 4   ? 0
    #    : $year % 100 ? 1
    #    : $year % 400 ? 0
    #    :               1;
    #
    # returns the index of the terminal question token, if any

my ($rcall_hash) = @_;

my $old_line       = $rcall_hash->{old_line};
    my $rfields        = $rcall_hash->{rfields};
    my $rtokens        = $rcall_hash->{rtokens};
    my $rpatterns      = $rcall_hash->{rpatterns};
    my $rfield_lengths = $rcall_hash->{rfield_lengths};
    my $group_level    = $rcall_hash->{group_level};

return if ( !$old_line );
    use constant EXPLAIN_TERNARY => 0;

if (%valign_control_hash) {
        my $align_ok = $valign_control_hash{'?'};
        $align_ok = $valign_control_default unless defined($align_ok);
        return if ( !$align_ok );
    }

my $jmax        = @{$rfields} - 1;
    my $rfields_old = $old_line->{'rfields'};

my $rpatterns_old       = $old_line->{'rpatterns'};
    my $rtokens_old         = $old_line->{'rtokens'};
    my $maximum_field_index = $old_line->{'jmax'};

# look for the question mark after the :
    my ($jquestion);
    my $depth_question;
    my $pad        = EMPTY_STRING;
    my $pad_length = 0;
    foreach my $j ( 0 .. $maximum_field_index - 1 ) {
        my $tok = $rtokens_old->[$j];
        my ( $raw_tok, $lev, $tag, $tok_count ) = decode_alignment_token($tok);
        if ( $raw_tok eq '?' ) {
            $depth_question = $lev;

# depth must be correct
            next if ( $depth_question ne $group_level );

$jquestion = $j;
            if ( $rfields_old->[ $j + 1 ] =~ /^(\?\s*)/ ) {
                $pad_length = length($1);
                $pad        = SPACE x $pad_length;
            }
            else {
                return;    # shouldn't happen
            }
            last;
        }
    }
    return if ( !defined($jquestion) );    # shouldn't happen

# Now splice the tokens and patterns of the previous line
    # into the else line to insure a match.  Add empty fields
    # as necessary.
    my $jadd = $jquestion;

# Work on copies of the actual arrays in case we have
    # to return due to an error
    my @fields        = @{$rfields};
    my @patterns      = @{$rpatterns};
    my @tokens        = @{$rtokens};
    my @field_lengths = @{$rfield_lengths};

EXPLAIN_TERNARY && do {
        local $LIST_SEPARATOR = '><';
        print {*STDOUT} "CURRENT FIELDS=<@{$rfields_old}>\n";
        print {*STDOUT} "CURRENT TOKENS=<@{$rtokens_old}>\n";
        print {*STDOUT} "CURRENT PATTERNS=<@{$rpatterns_old}>\n";
        print {*STDOUT} "UNMODIFIED FIELDS=<@{$rfields}>\n";
        print {*STDOUT} "UNMODIFIED TOKENS=<@{$rtokens}>\n";
        print {*STDOUT} "UNMODIFIED PATTERNS=<@{$rpatterns}>\n";
    };

# handle cases of leading colon on this line
    if ( $fields[0] =~ /^(:\s*)(.*)$/ ) {

my ( $colon, $therest ) = ( $1, $2 );

# Handle sub-case of first field with leading colon plus additional code
        # This is the usual situation as at the '1' below:
        #  ...
        #  : $year % 400 ? 0
        #  :               1;
        if ($therest) {

# Split the first field after the leading colon and insert padding.
            # Note that this padding will remain even if the terminal value goes
            # out on a separate line.  This does not seem to look to bad, so no
            # mechanism has been included to undo it.
            my $field1        = shift @fields;
            my $field_length1 = shift @field_lengths;
            my $len_colon     = length($colon);
            unshift @fields, ( $colon, $pad . $therest );
            unshift @field_lengths,
              ( $len_colon, $pad_length + $field_length1 - $len_colon );

# change the leading pattern from : to ?
            return if ( $patterns[0] !~ s/^\:/?/ );

# install leading tokens and patterns of existing line
            unshift( @tokens,   @{$rtokens_old}[ 0 .. $jquestion ] );
            unshift( @patterns, @{$rpatterns_old}[ 0 .. $jquestion ] );

# insert appropriate number of empty fields
            splice( @fields,        1, 0, (EMPTY_STRING) x $jadd ) if $jadd;
            splice( @field_lengths, 1, 0, (0) x $jadd )            if $jadd;
        }

# handle sub-case of first field just equal to leading colon.
        # This can happen for example in the example below where
        # the leading '(' would create a new alignment token
        # : ( $name =~ /[]}]$/ ) ? ( $mname = $name )
        # :                        ( $mname = $name . '->' );
        else {

return if ( $jmax <= 0 || $tokens[0] eq '#' );    # shouldn't happen

# prepend a leading ? onto the second pattern
            $patterns[1] = "?b" . $patterns[1];

# pad the second field
            $fields[1]        = $pad . $fields[1];
            $field_lengths[1] = $pad_length + $field_lengths[1];

# install leading tokens and patterns of existing line, replacing
            # leading token and inserting appropriate number of empty fields
            splice( @tokens,   0, 1, @{$rtokens_old}[ 0 .. $jquestion ] );
            splice( @patterns, 1, 0, @{$rpatterns_old}[ 1 .. $jquestion ] );
            splice( @fields,        1, 0, (EMPTY_STRING) x $jadd ) if $jadd;
            splice( @field_lengths, 1, 0, (0) x $jadd )            if $jadd;
        }
    }

# Handle case of no leading colon on this line.  This will
    # be the case when -wba=':' is used.  For example,
    #  $year % 400 ? 0 :
    #                1;
    else {

# install leading tokens and patterns of existing line
        $patterns[0] = '?' . 'b' . $patterns[0];
        unshift( @tokens,   @{$rtokens_old}[ 0 .. $jquestion ] );
        unshift( @patterns, @{$rpatterns_old}[ 0 .. $jquestion ] );

# insert appropriate number of empty fields
        $jadd             = $jquestion + 1;
        $fields[0]        = $pad . $fields[0];
        $field_lengths[0] = $pad_length + $field_lengths[0];
        splice( @fields,        0, 0, (EMPTY_STRING) x $jadd ) if $jadd;
        splice( @field_lengths, 0, 0, (0) x $jadd )            if $jadd;
    }

EXPLAIN_TERNARY && do {
        local $LIST_SEPARATOR = '><';
        print {*STDOUT} "MODIFIED TOKENS=<@tokens>\n";
        print {*STDOUT} "MODIFIED PATTERNS=<@patterns>\n";
        print {*STDOUT} "MODIFIED FIELDS=<@fields>\n";
    };

# all ok .. update the arrays
    @{$rfields}        = @fields;
    @{$rtokens}        = @tokens;
    @{$rpatterns}      = @patterns;
    @{$rfield_lengths} = @field_lengths;

# force a flush after this line
    return $jquestion;
} ## end sub fix_terminal_ternary

sub fix_terminal_else {

# Add empty fields as necessary to align a balanced terminal
    # else block to a previous if/elsif/unless block,
    # like this:
    #
    #  if   ( 1 || $x ) { print "ok 13\n"; }
    #  else             { print "not ok 13\n"; }
    #
    # returns a positive value if the else block should be indented
    #
    my ($rcall_hash) = @_;

return if ( !$old_line );
    my $jmax = @{$rfields} - 1;
    return if ( $jmax <= 0 );

if (%valign_control_hash) {
        my $align_ok = $valign_control_hash{'{'};
        $align_ok = $valign_control_default unless defined($align_ok);
        return if ( !$align_ok );
    }

# check for balanced else block following if/elsif/unless
    my $rfields_old = $old_line->{'rfields'};

# TBD: add handling for 'case'
    return if ( $rfields_old->[0] !~ /^(?:if|elsif|unless)\s*$/ );

# look for the opening brace after the else, and extract the depth
    my $tok_brace = $rtokens->[0];
    my $depth_brace;
    if ( $tok_brace =~ /^\{(\d+)/ ) { $depth_brace = $1; }

# probably:  "else # side_comment"
    else { return }

my $rpatterns_old       = $old_line->{'rpatterns'};
    my $rtokens_old         = $old_line->{'rtokens'};
    my $maximum_field_index = $old_line->{'jmax'};

# be sure the previous if/elsif is followed by an opening paren
    my $jparen    = 0;
    my $tok_paren = '(' . $depth_brace;
    my $tok_test  = $rtokens_old->[$jparen];
    return if ( $tok_test ne $tok_paren );    # shouldn't happen

# Now find the opening block brace
    my ($jbrace);
    foreach my $j ( 1 .. $maximum_field_index - 1 ) {
        my $tok = $rtokens_old->[$j];
        if ( $tok eq $tok_brace ) {
            $jbrace = $j;
            last;
        }
    }
    return if ( !defined($jbrace) );          # shouldn't happen

# Now splice the tokens and patterns of the previous line
    # into the else line to insure a match.  Add empty fields
    # as necessary.
    my $jadd = $jbrace - $jparen;
    splice( @{$rtokens},   0, 0, @{$rtokens_old}[ $jparen .. $jbrace - 1 ] );
    splice( @{$rpatterns}, 1, 0, @{$rpatterns_old}[ $jparen + 1 .. $jbrace ] );
    splice( @{$rfields},        1, 0, (EMPTY_STRING) x $jadd );
    splice( @{$rfield_lengths}, 1, 0, (0) x $jadd );

# force a flush after this line if it does not follow a case
    if   ( $rfields_old->[0] =~ /^case\s*$/ ) { return }
    else                                      { return $jbrace }
} ## end sub fix_terminal_else

my %is_closing_block_type;

BEGIN {
    my @q = qw< } ] >;
    @is_closing_block_type{@q} = (1) x scalar(@q);
}

# This is a flag for testing alignment by sub sweep_left_to_right only.
# This test can help find problems with the alignment logic.
# This flag should normally be zero.
use constant TEST_SWEEP_ONLY => 0;

use constant EXPLAIN_CHECK_MATCH => 0;

sub check_match {

# See if the current line matches the current vertical alignment group.

my ( $self, $new_line, $base_line, $prev_line, $group_line_count ) = @_;

# Given:
    #  $new_line  = the line being considered for group inclusion
    #  $base_line = the first line of the current group
    #  $prev_line = the line just before $new_line
    #  $group_line_count = number of lines in the current group

# returns a flag and a value as follows:
    #    return (0, $imax_align)   if the line does not match
    #    return (1, $imax_align)   if the line matches but does not fit
    #    return (2, $imax_align)   if the line matches and fits

use constant NO_MATCH      => 0;
    use constant MATCH_NO_FIT  => 1;
    use constant MATCH_AND_FIT => 2;

my $return_value;

# Returns '$imax_align' which is the index of the maximum matching token.
    # It will be used in the subsequent left-to-right sweep to align as many
    # tokens as possible for lines which partially match.
    my $imax_align = -1;

# variable $GoToMsg explains reason for no match, for debugging
    my $GoToMsg = EMPTY_STRING;

my $jmax                = $new_line->{'jmax'};
    my $maximum_field_index = $base_line->{'jmax'};

my $jlimit = $jmax - 2;
    if ( $jmax > $maximum_field_index ) {
        $jlimit = $maximum_field_index - 2;
    }

if ( $new_line->{'is_hanging_side_comment'} ) {

# HSC's can join the group if they fit
    }

# Everything else
    else {

# A group with hanging side comments ends with the first non hanging
        # side comment.
        if ( $base_line->{'is_hanging_side_comment'} ) {
            $GoToMsg      = "end of hanging side comments";
            $return_value = NO_MATCH;
        }
        else {

# The number of tokens that this line shares with the previous
            # line has been stored with the previous line.  This value was
            # calculated and stored by sub 'match_line_pair'.
            $imax_align = $prev_line->{'imax_pair'};

# Only the following ci sequences are accepted (issue c225):
            #   0 0 0 ...  OK
            #   0 1 1 ...  OK but marginal*
            #   1 1 1 ...  OK
            # This check is rarely activated, but for example we want
            # to avoid something like this 'tail wag dog' situation:
            #  $tag        =~ s/\b([a-z]+)/\L\u$1/gio;
            #  $tag        =~ s/\b([b-df-hj-np-tv-z]+)\b/\U$1/gio
            #      if $tag =~ /-/;
            # *Note: we could set a flag for the 0 1 marginal case and
            # use it to prevent alignment of selected token types.
            my $ci_prev = $prev_line->{'ci_level'};
            my $ci_new  = $new_line->{'ci_level'};
            if (   $ci_prev != $ci_new
                && $imax_align >= 0
                && ( $ci_new == 0 || $group_line_count > 1 ) )
            {
                $imax_align = -1;
                $GoToMsg =
"Rejected ci: ci_prev=$ci_prev ci_new=$ci_new num=$group_line_count\n";
                $return_value = NO_MATCH;
            }
            elsif ( $imax_align != $jlimit ) {
                $GoToMsg = "Not all tokens match: $imax_align != $jlimit\n";
                $return_value = NO_MATCH;
            }
            else {
                ##ok: continue
            }
        }
    }

if ( !defined($return_value) ) {

# The tokens match, but the lines must have identical number of
        # tokens to join the group.
        if ( $maximum_field_index != $jmax ) {
            $GoToMsg      = "token count differs";
            $return_value = NO_MATCH;
        }

# The tokens match. Now See if there is space for this line in the
        # current group.
        elsif ( $self->check_fit( $new_line, $base_line ) && !TEST_SWEEP_ONLY )
        {

$GoToMsg = "match and fit, imax_align=$imax_align, jmax=$jmax\n";
            $return_value = MATCH_AND_FIT;
            $imax_align   = $jlimit;
        }
        else {
            $GoToMsg = "match but no fit, imax_align=$imax_align, jmax=$jmax\n";
            $return_value = MATCH_NO_FIT;
            $imax_align   = $jlimit;
        }
    }

EXPLAIN_CHECK_MATCH
      && print
"returning $return_value because $GoToMsg, max match index =i $imax_align, jmax=$jmax\n";

return ( $return_value, $imax_align );
} ## end sub check_match

sub check_fit {

my ( $self, $new_line, $old_line ) = @_;

# The new line has alignments identical to the current group. Now we have
    # to fit the new line into the group without causing a field to exceed the
    # line length limit.
    #   return true if successful
    #   return false if not successful

my $jmax                = $new_line->{'jmax'};
    my $leading_space_count = $new_line->{'leading_space_count'};
    my $rfield_lengths      = $new_line->{'rfield_lengths'};
    my $padding_available   = $old_line->get_available_space_on_right();
    my $jmax_old            = $old_line->{'jmax'};

# Safety check ... only lines with equal array sizes should arrive here
    # from sub check_match.  So if this error occurs, look at recent changes in
    # sub check_match.  It is only supposed to check the fit of lines with
    # identical numbers of alignment tokens.
    if ( $jmax_old ne $jmax ) {

warning(<<EOM);
Program bug detected in Perl::Tidy::VerticalAligner sub check_fit
unexpected difference in array lengths: $jmax != $jmax_old
EOM
        return;
    }

# Save current columns in case this line does not fit.
    my @alignments = @{ $old_line->{'ralignments'} };
    foreach my $alignment (@alignments) {
        $alignment->save_column();
    }

# Loop over all alignments ...
    for my $j ( 0 .. $jmax ) {

my $pad = $rfield_lengths->[$j] - $old_line->current_field_width($j);

if ( $j == 0 ) {
            $pad += $leading_space_count;
        }

# Keep going if this field does not need any space.
        next if ( $pad < 0 );

# Revert to the starting state if does not fit
        if ( $pad > $padding_available ) {

#----------------------------------------------
            # Line does not fit -- revert to starting state
            #----------------------------------------------
            foreach my $alignment (@alignments) {
                $alignment->restore_column();
            }
            return;
        }

# make room for this field
        $old_line->increase_field_width( $j, $pad );
        $padding_available -= $pad;
    }

#-------------------------------------
    # The line fits, the match is accepted
    #-------------------------------------
    return 1;

} ## end sub check_fit

sub install_new_alignments {

my ($new_line) = @_;

my $jmax           = $new_line->{'jmax'};
    my $rfield_lengths = $new_line->{'rfield_lengths'};
    my $col            = $new_line->{'leading_space_count'};

my @alignments;
    for my $j ( 0 .. $jmax ) {
        $col += $rfield_lengths->[$j];

# create initial alignments for the new group
        my $alignment =
          Perl::Tidy::VerticalAligner::Alignment->new( { column => $col } );
        push @alignments, $alignment;
    }
    $new_line->{'ralignments'} = \@alignments;
    return;
} ## end sub install_new_alignments

sub copy_old_alignments {
    my ( $new_line, $old_line ) = @_;
    my @new_alignments = @{ $old_line->{'ralignments'} };
    $new_line->{'ralignments'} = \@new_alignments;
    return;
} ## end sub copy_old_alignments

sub dump_array {

# debug routine to dump array contents
    local $LIST_SEPARATOR = ')(';
    print {*STDOUT} "(@_)\n";
    return;
} ## end sub dump_array

sub level_change {

# compute decrease in level when we remove $diff spaces from the
    # leading spaces
    my ( $self, $leading_space_count, $diff, $level ) = @_;

if ($rOpts_indent_columns) {
        my $olev =
          int( ( $leading_space_count + $diff ) / $rOpts_indent_columns );
        my $nlev = int( $leading_space_count / $rOpts_indent_columns );
        $level -= ( $olev - $nlev );
        if ( $level < 0 ) { $level = 0 }
    }
    return $level;
} ## end sub level_change

###############################################
# CODE SECTION 4: Code to process comment lines
###############################################

sub _flush_comment_lines {

# Output a group consisting of COMMENT lines

my ($self) = @_;
    my $rgroup_lines = $self->[_rgroup_lines_];
    return if ( !@{$rgroup_lines} );
    my $group_level               = $self->[_group_level_];
    my $group_maximum_line_length = $self->[_group_maximum_line_length_];
    my $leading_space_count       = $self->[_comment_leading_space_count_];

# look for excessively long lines
    my $max_excess = 0;
    foreach my $item ( @{$rgroup_lines} ) {
        my ( $str, $str_len ) = @{$item};
        my $excess =
          $str_len + $leading_space_count - $group_maximum_line_length;
        if ( $excess > $max_excess ) {
            $max_excess = $excess;
        }
    }

# zero leading space count if any lines are too long
    if ( $max_excess > 0 ) {
        $leading_space_count -= $max_excess;
        if ( $leading_space_count < 0 ) { $leading_space_count = 0 }
        my $file_writer_object = $self->[_file_writer_object_];
        my $last_outdented_line_at =
          $file_writer_object->get_output_line_number();
        my $nlines = @{$rgroup_lines};
        $self->[_last_outdented_line_at_] =
          $last_outdented_line_at + $nlines - 1;
        my $outdented_line_count = $self->[_outdented_line_count_];
        if ( !$outdented_line_count ) {
            $self->[_first_outdented_line_at_] = $last_outdented_line_at;
        }
        $outdented_line_count += $nlines;
        $self->[_outdented_line_count_] = $outdented_line_count;
    }

# write the lines
    my $outdent_long_lines = 0;

foreach my $item ( @{$rgroup_lines} ) {
        my ( $str, $str_len, $Kend ) = @{$item};
        $self->valign_output_step_B(
            {
                leading_space_count       => $leading_space_count,
                line                      => $str,
                line_length               => $str_len,
                side_comment_length       => 0,
                outdent_long_lines        => $outdent_long_lines,
                rvertical_tightness_flags => undef,
                level                     => $group_level,
                level_end                 => $group_level,
                Kend                      => $Kend,
                maximum_line_length       => $group_maximum_line_length,
            }
        );
    }

$self->initialize_for_new_group();
    return;
} ## end sub _flush_comment_lines

######################################################
# CODE SECTION 5: Code to process groups of code lines
######################################################

sub _flush_group_lines {

# This is the vertical aligner internal flush, which leaves the cache
    # intact
    my ( $self, $level_jump ) = @_;

# $level_jump = $next_level-$group_level, if known
    #             = undef if not known
    # Note: only the sign of the jump is needed

my $rgroup_lines = $self->[_rgroup_lines_];
    return if ( !@{$rgroup_lines} );
    my $group_type  = $self->[_group_type_];
    my $group_level = $self->[_group_level_];

# Debug
    0 && do {
        my ( $a, $b, $c ) = caller();
        my $nlines = @{$rgroup_lines};
        print {*STDOUT}
"APPEND0: _flush_group_lines called from $a $b $c lines=$nlines, type=$group_type \n";
    };

#-------------------------------------------
    # Section 1: Handle a group of COMMENT lines
    #-------------------------------------------
    if ( $group_type eq 'COMMENT' ) {
        $self->_flush_comment_lines();
        return;
    }

#------------------------------------------------------------------------
    # Section 2: Handle line(s) of CODE.  Most of the actual work of vertical
    # aligning happens here in the following steps:
    #------------------------------------------------------------------------

# STEP 1: Remove most unmatched tokens. They block good alignments.
    my ( $max_lev_diff, $saw_side_comment ) =
      delete_unmatched_tokens( $rgroup_lines, $group_level );

# STEP 2: Sweep top to bottom, forming subgroups of lines with exactly
    # matching common alignments.  The indexes of these subgroups are in the
    # return variable.
    my $rgroups = $self->sweep_top_down( $rgroup_lines, $group_level );

# STEP 3: Sweep left to right through the lines, looking for leading
    # alignment tokens shared by groups.
    sweep_left_to_right( $rgroup_lines, $rgroups, $group_level )
      if ( @{$rgroups} > 1 );

# STEP 4: Move side comments to a common column if possible.
    if ($saw_side_comment) {
        $self->align_side_comments( $rgroup_lines, $rgroups );
    }

# STEP 5: For the -lp option, increase the indentation of lists
    # to the desired amount, but do not exceed the line length limit.

# We are allowed to shift a group of lines to the right if:
    #  (1) its level is greater than the level of the previous group, and
    #  (2) its level is greater than the level of the next line to be written.

my $extra_indent_ok;
    if ( $group_level > $self->[_last_level_written_] ) {

# Use the level jump to next line to come, if given
        if ( defined($level_jump) ) {
            $extra_indent_ok = $level_jump < 0;
        }

# Otherwise, assume the next line has the level of the end of last line.
        # This fixes case c008.
        else {
            my $level_end = $rgroup_lines->[-1]->{'level_end'};
            $extra_indent_ok = $group_level > $level_end;
        }
    }

my $extra_leading_spaces =
      $extra_indent_ok
      ? get_extra_leading_spaces( $rgroup_lines, $rgroups )
      : 0;

# STEP 6: add sign padding to columns numbers if needed
    pad_signed_number_columns($rgroup_lines)
      if ($rOpts_valign_signed_numbers);

# STEP 7: pad wide equals
    pad_wide_equals_columns($rgroup_lines)
      if ($rOpts_valign_wide_equals);

# STEP 8: Output the lines.
    # All lines in this group have the same leading spacing and maximum line
    # length
    my $group_leader_length       = $rgroup_lines->[0]->{'leading_space_count'};
    my $group_maximum_line_length = $rgroup_lines->[0]->{'maximum_line_length'};

foreach my $line ( @{$rgroup_lines} ) {
        $self->valign_output_step_A(
            {
                line                 => $line,
                min_ci_gap           => 0,
                do_not_align         => 0,
                group_leader_length  => $group_leader_length,
                extra_leading_spaces => $extra_leading_spaces,
                level                => $group_level,
                maximum_line_length  => $group_maximum_line_length,
            }
        );
    }

# Let the formatter know that this object has been processed and any
    # recoverable spaces have been handled.  This is needed for setting the
    # closing paren location in -lp mode.
    my $object = $rgroup_lines->[0]->{'indentation'};
    if ( ref($object) ) { $object->set_recoverable_spaces(0) }

$self->initialize_for_new_group();
    return;
} ## end sub _flush_group_lines

{    ## closure for sub sweep_top_down

my $rall_lines;         # all of the lines
    my $grp_level;          # level of all lines
    my $rgroups;            # describes the partition of lines we will make here
    my $group_line_count;   # number of lines in current partition

BEGIN { $rgroups = [] }

sub initialize_for_new_rgroup {
        $group_line_count = 0;
        return;
    }

sub add_to_rgroup {

my ($jend) = @_;
        my $rline = $rall_lines->[$jend];

my $jbeg = $jend;
        if ( $group_line_count == 0 ) {
            install_new_alignments($rline);
        }
        else {
            my $rvals = pop @{$rgroups};
            $jbeg = $rvals->[0];
            copy_old_alignments( $rline, $rall_lines->[$jbeg] );
        }
        push @{$rgroups}, [ $jbeg, $jend, undef ];
        $group_line_count++;
        return;
    } ## end sub add_to_rgroup

sub get_rgroup_jrange {

return if ( !@{$rgroups} );
        return if ( $group_line_count <= 0 );
        my ( $jbeg, $jend ) = @{ $rgroups->[-1] };
        return ( $jbeg, $jend );
    } ## end sub get_rgroup_jrange

sub end_rgroup {

my ($imax_align) = @_;
        return if ( !@{$rgroups} );
        return if ( $group_line_count <= 0 );

my ( $jbeg, $jend ) = @{ pop @{$rgroups} };
        push @{$rgroups}, [ $jbeg, $jend, $imax_align ];

# Undo some alignments of poor two-line combinations.
        # We had to wait until now to know the line count.
        if ( $jend - $jbeg == 1 ) {
            my $line_0 = $rall_lines->[$jbeg];
            my $line_1 = $rall_lines->[$jend];

my $imax_pair = $line_1->{'imax_pair'};
            if ( $imax_pair > $imax_align ) { $imax_align = $imax_pair }

## flag for possible future use:
            ## my $is_isolated_pair = $imax_pair < 0
            ##  && ( $jbeg == 0
            ##    || $rall_lines->[ $jbeg - 1 ]->{'imax_pair'} < 0 );

my $imax_prev =
              $jbeg > 0 ? $rall_lines->[ $jbeg - 1 ]->{'imax_pair'} : -1;

my ( $is_marginal, $imax_align_fix ) =
              is_marginal_match( $line_0, $line_1, $grp_level, $imax_align,
                $imax_prev );
            if ($is_marginal) {
                combine_fields( $line_0, $line_1, $imax_align_fix );
            }
        }

initialize_for_new_rgroup();
        return;
    } ## end sub end_rgroup

sub block_penultimate_match {

# emergency reset to prevent sweep_left_to_right from trying to match a
        # failed terminal else match
        return if ( @{$rgroups} <= 1 );
        $rgroups->[-2]->[2] = -1;
        return;
    } ## end sub block_penultimate_match

sub sweep_top_down {
        my ( $self, $rlines, $group_level ) = @_;

# Partition the set of lines into final alignment subgroups
        # and store the alignments with the lines.

# The alignment subgroups we are making here are groups of consecutive
        # lines which have (1) identical alignment tokens and (2) do not
        # exceed the allowable maximum line length.  A later sweep from
        # left-to-right ('sweep_lr') will handle additional alignments.

# transfer args to closure variables
        $rall_lines = $rlines;
        $grp_level  = $group_level;
        $rgroups    = [];
        initialize_for_new_rgroup();
        return unless @{$rlines};    # shouldn't happen

# Unset the _end_group flag for the last line if it it set because it
        # is not needed and can causes problems for -lp formatting
        $rall_lines->[-1]->{'end_group'} = 0;

# Loop over all lines ...
        my $jline = -1;
        foreach my $new_line ( @{$rall_lines} ) {
            $jline++;

# Start a new subgroup if necessary
            if ( !$group_line_count ) {
                add_to_rgroup($jline);
                if ( $new_line->{'end_group'} ) {
                    end_rgroup(-1);
                }
                next;
            }

my $j_terminal_match = $new_line->{'j_terminal_match'};
            my ( $jbeg, $jend ) = get_rgroup_jrange();
            if ( !defined($jbeg) ) {

# safety check, shouldn't happen
                warning(<<EOM);
Program bug detected in Perl::Tidy::VerticalAligner sub sweep_top_down
undefined index for group line count $group_line_count
EOM
                $jbeg = $jline;
            }
            my $base_line = $rall_lines->[$jbeg];

# Initialize a global flag saying if the last line of the group
            # should match end of group and also terminate the group.  There
            # should be no returns between here and where the flag is handled
            # at the bottom.
            my $col_matching_terminal = 0;
            if ( defined($j_terminal_match) ) {

# remember the column of the terminal ? or { to match with
                $col_matching_terminal =
                  $base_line->get_column($j_terminal_match);

# Ignore an undefined value as a defensive step; shouldn't
                # normally happen.
                $col_matching_terminal = 0
                  unless defined($col_matching_terminal);
            }

# -------------------------------------------------------------
            # Allow hanging side comment to join current group, if any.  The
            # only advantage is to keep the other tokens in the same group. For
            # example, this would make the '=' align here:
            #  $ax         = 1;           # side comment
            #                             # hanging side comment
            #  $boondoggle = 5;           # side comment
            #  $beetle     = 5;           # side comment

# here is another example..

#  _rtoc_name_count   => {},                   # hash to track ..
            #  _rpackage_stack    => [],                   # stack to check ..
            #                                              # name changes
            #  _rlast_level       => \$last_level,         # brace indentation
            #
            #
            # If this were not desired, the next step could be skipped.
            # -------------------------------------------------------------
            if ( $new_line->{'is_hanging_side_comment'} ) {
                join_hanging_comment( $new_line, $base_line );
            }

# If this line has no matching tokens, then flush out the lines
            # BEFORE this line unless both it and the previous line have side
            # comments.  This prevents this line from pushing side comments out
            # to the right.
            elsif ( $new_line->{'jmax'} == 1 ) {

# There are no matching tokens, so now check side comments.
                # Programming note: accessing arrays with index -1 is
                # risky in Perl, but we have verified there is at least one
                # line in the group and that there is at least one field,
                my $prev_comment =
                  $rall_lines->[ $jline - 1 ]->{'rfields'}->[-1];
                my $side_comment = $new_line->{'rfields'}->[-1];

# do not end group if both lines have side comments
                if ( !$side_comment || !$prev_comment ) {

# Otherwise - VSN PATCH for a single number:
                    # - do not end group if numeric and no side comment, or
                    # - end if !numeric or side comment
                    my $pat        = $new_line->{'rpatterns'}->[0];
                    my $is_numeric = $rOpts_valign_signed_numbers
                      && ( $pat eq 'n,'
                        || $pat eq 'n,b' );
                    end_rgroup(-1) if ( !$is_numeric || $side_comment );
                }
            }
            else {
                ##ok: continue
            }

# See if the new line matches and fits the current group,
            # if it still exists. Flush the current group if not.
            my $match_code;
            if ($group_line_count) {
                ( $match_code, my $imax_align ) =
                  $self->check_match( $new_line, $base_line,
                    $rall_lines->[ $jline - 1 ],
                    $group_line_count );
                if ( $match_code != 2 ) { end_rgroup($imax_align) }
            }

# Store the new line
            add_to_rgroup($jline);

if ( defined($j_terminal_match) ) {

# Decide if we should fix a terminal match. We can either:
                # 1. fix it and prevent the sweep_lr from changing it, or
                # 2. leave it alone and let sweep_lr try to fix it.

# The current logic is to fix it if:
                # -it has not joined to previous lines,
                # -and either the previous subgroup has just 1 line, or
                # -this line matched but did not fit (so sweep won't work)
                my $fixit;
                if ( $group_line_count == 1 ) {
                    $fixit ||= $match_code;
                    if ( !$fixit ) {
                        if ( @{$rgroups} > 1 ) {
                            my ( $jbegx, $jendx ) = @{ $rgroups->[-2] };
                            my $nlines = $jendx - $jbegx + 1;
                            $fixit ||= $nlines <= 1;
                        }
                    }
                }

if ($fixit) {
                    $base_line = $new_line;
                    my $col_now = $base_line->get_column($j_terminal_match);

# Ignore an undefined value as a defensive step; shouldn't
                    # normally happen.
                    $col_now = 0 unless defined($col_now);

my $pad = $col_matching_terminal - $col_now;
                    my $padding_available =
                      $base_line->get_available_space_on_right();
                    if ( $col_now && $pad > 0 && $pad <= $padding_available ) {
                        $base_line->increase_field_width( $j_terminal_match,
                            $pad );
                    }

# do not let sweep_left_to_right change an isolated 'else'
                    if ( !$new_line->{'is_terminal_ternary'} ) {
                        block_penultimate_match();
                    }
                }
                end_rgroup(-1);
            }

# end the group if we know we cannot match next line.
            elsif ( $new_line->{'end_group'} ) {
                end_rgroup(-1);
            }

else {
                ##ok: continue
            }
        } ## end loop over lines

end_rgroup(-1);
        return ($rgroups);
    } ## end sub sweep_top_down
}

sub two_line_pad {

my ( $line_m, $line, $imax_min ) = @_;

# Given:
    #  two isolated (list) lines
    #  imax_min = number of common alignment tokens
    # Return:
    #  $pad_max = maximum suggested pad distance
    #           = 0 if alignment not recommended
    # Note that this is only for two lines which do not have alignment tokens
    # in common with any other lines.  It is intended for lists, but it might
    # also be used for two non-list lines with a common leading '='.

# Allow alignment if the difference in the two unpadded line lengths
    # is not more than either line length.  The idea is to avoid
    # aligning lines with very different field lengths, like these two:

#   [
    #       'VARCHAR', DBI::SQL_VARCHAR, undef, "'", "'", undef, 0, 1,
    #       1, 0, 0, 0, undef, 0, 0
    #   ];
    my $rfield_lengths   = $line->{'rfield_lengths'};
    my $rfield_lengths_m = $line_m->{'rfield_lengths'};

# Safety check - shouldn't happen
    return 0
      if ( $imax_min >= @{$rfield_lengths}
        || $imax_min >= @{$rfield_lengths_m} );

my $lensum_m = 0;
    my $lensum   = 0;
    foreach my $i ( 0 .. $imax_min ) {
        $lensum_m += $rfield_lengths_m->[$i];
        $lensum   += $rfield_lengths->[$i];
    }

my ( $lenmin, $lenmax ) =
      $lensum >= $lensum_m ? ( $lensum_m, $lensum ) : ( $lensum, $lensum_m );

my $patterns_match;
    if ( $line_m->{'list_type'} && $line->{'list_type'} ) {
        $patterns_match = 1;
        my $rpatterns_m = $line_m->{'rpatterns'};
        my $rpatterns   = $line->{'rpatterns'};
        foreach my $i ( 0 .. $imax_min ) {
            my $pat   = $rpatterns->[$i];
            my $pat_m = $rpatterns_m->[$i];

# VSN PATCH: allow numbers to match quotes
            if ( $pat_m ne $pat && length($pat_m) eq length($pat) ) {
                $pat   =~ tr/n/Q/;
                $pat_m =~ tr/n/Q/;
            }

if ( $pat ne $pat_m ) { $patterns_match = 0; last; }
        }
    }

my $pad_max = $lenmax;
    if ( !$patterns_match && $lenmax > 2 * $lenmin ) { $pad_max = 0 }

return $pad_max;
} ## end sub two_line_pad

sub sweep_left_to_right {

my ( $rlines, $rgroups, $group_level ) = @_;

# So far we have divided the lines into groups having an equal number of
    # identical alignments.  Here we are going to look for common leading
    # alignments between the different groups and align them when possible.
    # For example, the three lines below are in three groups because each line
    # has a different number of commas.  In this routine we will sweep from
    # left to right, aligning the leading commas as we go, but stopping if we
    # hit the line length limit.

#  my ( $num, $numi, $numj,  $xyza, $ka,   $xyzb, $kb, $aff, $error );
    #  my ( $i,   $j,    $error, $aff,  $asum, $avec );
    #  my ( $km,  $area, $varea );

# nothing to do if just one group
    my $ng_max = @{$rgroups} - 1;
    return if ( $ng_max <= 0 );

#---------------------------------------------------------------------
    # Step 1: Loop over groups to find all common leading alignment tokens
    #---------------------------------------------------------------------

my $line;
    my $rtokens;
    my $imax;     # index of maximum non-side-comment alignment token
    my $istop;    # an optional stopping index
    my $jbeg;     # starting line index
    my $jend;     # ending line index

my $line_m;
    my $rtokens_m;
    my $imax_m;
    my $istop_m;
    my $jbeg_m;
    my $jend_m;

my $istop_mm;

# Look at neighboring pairs of groups and form a simple list
    # of all common leading alignment tokens. Foreach such match we
    # store [$i, $ng], where
    #  $i = index of the token in the line (0,1,...)
    #  $ng is the second of the two groups with this common token
    my @icommon;

# Hash to hold the maximum alignment change for any group
    my %max_move;

# a small number of columns
    my $short_pad = 4;

my $ng = -1;
    foreach my $item ( @{$rgroups} ) {
        $ng++;

$istop_mm = $istop_m;

# save _m values of previous group
        $line_m    = $line;
        $rtokens_m = $rtokens;
        $imax_m    = $imax;
        $istop_m   = $istop;
        $jbeg_m    = $jbeg;
        $jend_m    = $jend;

# Get values for this group. Note that we just have to use values for
        # one of the lines of the group since all members have the same
        # alignments.
        ( $jbeg, $jend, $istop ) = @{$item};

$line    = $rlines->[$jbeg];
        $rtokens = $line->{'rtokens'};
        $imax    = $line->{'jmax'} - 2;
        $istop   = -1    if ( !defined($istop) );
        $istop   = $imax if ( $istop > $imax );

# Initialize on first group
        next if ( $ng == 0 );

# Use the minimum index limit of the two groups
        my $imax_min = $imax > $imax_m ? $imax_m : $imax;

# Also impose a limit if given.
        if ( $istop_m < $imax_min ) {
            $imax_min = $istop_m;
        }

# Special treatment of two one-line groups isolated from other lines,
        # unless they form a simple list or a terminal match.  Otherwise the
        # alignment can look strange in some cases.
        my $list_type = $rlines->[$jbeg]->{'list_type'};
        if (
               $jend == $jbeg
            && $jend_m == $jbeg_m
            && ( $ng == 1 || $istop_mm < 0 )
            && ( $ng == $ng_max || $istop < 0 )
            && !$line->{'j_terminal_match'}

# Only do this for imperfect matches. This is normally true except
            # when two perfect matches cannot form a group because the line
            # length limit would be exceeded. In that case we can still try
            # to match as many alignments as possible.
            && ( $imax != $imax_m || $istop_m != $imax_m )
          )
        {

# We will just align assignments and simple lists
            next if ( $imax_min < 0 );
            next
              if ( $rtokens->[0] !~ /^=\d/
                && !$list_type );

# In this case we will limit padding to a short distance.  This
            # is a compromise to keep some vertical alignment but prevent large
            # gaps, which do not look good for just two lines.
            my $pad_max =
              two_line_pad( $rlines->[$jbeg], $rlines->[$jbeg_m], $imax_min );
            next if ( !$pad_max );
            my $ng_m = $ng - 1;
            $max_move{"$ng_m"} = $pad_max;
            $max_move{"$ng"}   = $pad_max;
        }

# Loop to find all common leading tokens.
        if ( $imax_min >= 0 ) {
            foreach my $i ( 0 .. $imax_min ) {
                my $tok   = $rtokens->[$i];
                my $tok_m = $rtokens_m->[$i];
                last if ( $tok ne $tok_m );
                push @icommon, [ $i, $ng, $tok ];
            }
        }
    }
    return unless @icommon;

#----------------------------------------------------------
    # Step 2: Reorder and consolidate the list into a task list
    #----------------------------------------------------------

# We have to work first from lowest token index to highest, then by group,
    # sort our list first on token index then group number
    @icommon = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @icommon;

# Make a task list of the form
    #   [$i, ng_beg, $ng_end, $tok], ..
    # where
    #   $i is the index of the token to be aligned
    #   $ng_beg..$ng_end is the group range for this action
    my @todo;
    my ( $i, $ng_end, $tok );
    foreach my $item (@icommon) {
        my $ng_last = $ng_end;
        my $i_last  = $i;
        ( $i, $ng_end, $tok ) = @{$item};
        my $ng_beg = $ng_end - 1;
        if ( defined($ng_last) && $ng_beg == $ng_last && $i == $i_last ) {
            my $var = pop(@todo);
            $ng_beg = $var->[1];
        }
        my ( $raw_tok, $lev, $tag, $tok_count ) = decode_alignment_token($tok);
        push @todo, [ $i, $ng_beg, $ng_end, $raw_tok, $lev ];
    }

#------------------------------
    # Step 3: Execute the task list
    #------------------------------
    do_left_to_right_sweep(
        {
            rlines      => $rlines,
            rgroups     => $rgroups,
            rtodo       => \@todo,
            rmax_move   => \%max_move,
            short_pad   => $short_pad,
            group_level => $group_level,
        }
    );
    return;
} ## end sub sweep_left_to_right

{    ## closure for sub do_left_to_right_sweep

my %is_good_alignment_token;

BEGIN {

# One of the most difficult aspects of vertical alignment is knowing
        # when not to align.  Alignment can go from looking very nice to very
        # bad when overdone.  In the sweep algorithm there are two special
        # cases where we may need to limit padding to a '$short_pad' distance
        # to avoid some very ugly formatting:

# 1. Two isolated lines with partial alignment
        # 2. A 'tail-wag-dog' situation, in which a single terminal
        #    line with partial alignment could cause a significant pad
        #    increase in many previous lines if allowed to join the alignment.

# For most alignment tokens, we will allow only a small pad to be
        # introduced (the hardwired $short_pad variable) . But for some 'good'
        # alignments we can be less restrictive.

# These are 'good' alignments, which are allowed more padding:
        my @q = qw(
          => = ? if unless or || {
        );
        push @q, ',';
        @is_good_alignment_token{@q} = (0) x scalar(@q);

# Promote a few of these to 'best', with essentially no pad limit:
        $is_good_alignment_token{'='}      = 1;
        $is_good_alignment_token{'if'}     = 1;
        $is_good_alignment_token{'unless'} = 1;
        $is_good_alignment_token{'=>'}     = 1;

# Note the hash values are set so that:
        #         if ($is_good_alignment_token{$raw_tok}) => best
        # if defined ($is_good_alignment_token{$raw_tok}) => good or best

} ## end BEGIN

sub move_to_common_column {

# This is a sub called by sub do_left_to_right_sweep to
        # move the alignment column of token $itok to $col_want for a
        # sequence of groups.
        my ($rcall_hash) = @_;

my $rlines    = $rcall_hash->{rlines};
        my $rgroups   = $rcall_hash->{rgroups};
        my $rmax_move = $rcall_hash->{rmax_move};
        my $ngb       = $rcall_hash->{ngb};
        my $nge       = $rcall_hash->{nge};
        my $itok      = $rcall_hash->{itok};
        my $col_want  = $rcall_hash->{col_want};
        my $raw_tok   = $rcall_hash->{raw_tok};

return if ( !defined($ngb) || $nge <= $ngb );
        foreach my $ng ( $ngb .. $nge ) {

my ( $jbeg, $jend ) = @{ $rgroups->[$ng] };
            my $line = $rlines->[$jbeg];
            my $col  = $line->get_column($itok);
            my $move = $col_want - $col;
            if ( $move > 0 ) {

# limit padding increase in isolated two lines
                next
                  if ( defined( $rmax_move->{$ng} )
                    && $move > $rmax_move->{$ng}
                    && !$is_good_alignment_token{$raw_tok} );

$line->increase_field_width( $itok, $move );
            }
            elsif ( $move < 0 ) {

# spot to take special action on failure to move
            }
            else {
                ##ok: (move==0)
            }
        }
        return;
    } ## end sub move_to_common_column

sub do_left_to_right_sweep {

my ($rcall_hash) = @_;

# This is the worker routine for sub 'sweep_left_to_right'. Make
        # vertical alignments by sweeping from left to right over groups
        # of lines which have been located and prepared by the caller.

my $rlines      = $rcall_hash->{rlines};
        my $rgroups     = $rcall_hash->{rgroups};
        my $rtodo       = $rcall_hash->{rtodo};
        my $rmax_move   = $rcall_hash->{rmax_move};
        my $short_pad   = $rcall_hash->{short_pad};
        my $group_level = $rcall_hash->{group_level};

# $blocking_level[$nj is the level at a match failure between groups
        # $ng-1 and $ng
        my @blocking_level;
        my $group_list_type = $rlines->[0]->{'list_type'};

foreach my $task ( @{$rtodo} ) {
            my ( $itok, $ng_beg, $ng_end, $raw_tok, $lev ) = @{$task};

# Nothing to do for a single group
            next if ( $ng_end <= $ng_beg );

my $ng_first;  # index of the first group of a continuous sequence
            my $col_want;  # the common alignment column of a sequence of groups
            my $col_limit; # maximum column before bumping into max line length
            my $line_count_ng_m = 0;
            my $jmax_m;
            my $it_stop_m;

# Loop over the groups
            # 'ix_' = index in the array of lines
            # 'ng_' = index in the array of groups
            # 'it_' = index in the array of tokens
            my $ix_min      = $rgroups->[$ng_beg]->[0];
            my $ix_max      = $rgroups->[$ng_end]->[1];
            my $lines_total = $ix_max - $ix_min + 1;
            foreach my $ng ( $ng_beg .. $ng_end ) {
                my ( $ix_beg, $ix_end, $it_stop ) = @{ $rgroups->[$ng] };
                my $line_count_ng = $ix_end - $ix_beg + 1;

# Important: note that since all lines in a group have a common
                # alignments object, we just have to work on one of the lines
                # (the first line).  All of the rest will be changed
                # automatically.
                my $line = $rlines->[$ix_beg];
                my $jmax = $line->{'jmax'};

# the maximum space without exceeding the line length:
                my $avail   = $line->get_available_space_on_right();
                my $col     = $line->get_column($itok);
                my $col_max = $col + $avail;

# Initialize on first group
                if ( !defined($col_want) ) {
                    $ng_first        = $ng;
                    $col_want        = $col;
                    $col_limit       = $col_max;
                    $line_count_ng_m = $line_count_ng;
                    $jmax_m          = $jmax;
                    $it_stop_m       = $it_stop;
                    next;
                }

# RULE: Throw a blocking flag upon encountering a token level
                # different from the level of the first blocking token.  For
                # example, in the following example, if the = matches get
                # blocked between two groups as shown, then we want to start
                # blocking matches at the commas, which are at deeper level, so
                # that we do not get the big gaps shown here:

#  my $unknown3 = pack( "v",          -2 );
                #  my $unknown4 = pack( "v",          0x09 );
                #  my $unknown5 = pack( "VVV",        0x06, 0x00, 0x00 );
                #  my $num_bbd_blocks  = pack( "V",   $num_lists );
                #  my $root_startblock = pack( "V",   $root_start );
                #  my $unknown6        = pack( "VV",  0x00, 0x1000 );

# On the other hand, it is okay to keep matching at the same
                # level such as in a simple list of commas and/or fat commas.

my $is_blocked = defined( $blocking_level[$ng] )
                  && $lev > $blocking_level[$ng];

# TAIL-WAG-DOG RULE: prevent a 'tail-wag-dog' syndrom, meaning:
                # Do not let one or two lines with a **different number of
                # alignments** open up a big gap in a large block.  For
                # example, we will prevent something like this, where the first
                # line pries open the rest:

#  $worksheet->write( "B7", "http://www.perl.com", undef, $format );
            #  $worksheet->write( "C7", "",                    $format );
            #  $worksheet->write( "D7", "",                    $format );
            #  $worksheet->write( "D8", "",                    $format );
            #  $worksheet->write( "D8", "",                    $format );

# We should exclude from consideration two groups which are
                # effectively the same but separated because one does not
                # fit in the maximum allowed line length.
                my $is_same_group =
                  $jmax == $jmax_m && $it_stop_m == $jmax_m - 2;

my $lines_above = $ix_beg - $ix_min;
                my $lines_below = $lines_total - $lines_above;

# Increase the tolerable gap for certain favorable factors
                my $factor    = 1;
                my $top_level = $lev == $group_level;

# Align best top level alignment tokens like '=', 'if', ...
                # A factor of 10 allows a gap of up to 40 spaces
                if ( $top_level && $is_good_alignment_token{$raw_tok} ) {
                    $factor = 10;
                }

# Otherwise allow some minimal padding of good alignments
                else {

if (

defined( $is_good_alignment_token{$raw_tok} )

# We have to be careful if there are just 2 lines.
                        # This two-line factor allows large gaps only for 2
                        # lines which are simple lists with fewer items on the
                        # second line. It gives results similar to previous
                        # versions of perltidy.
                        && (
                            $lines_total > 2
                            || (   $group_list_type
                                && $jmax < $jmax_m
                                && $top_level )
                        )
                      )
                    {
                        $factor += 1;
                        if ($top_level) {
                            $factor += 1;
                        }
                    }
                }

my $is_big_gap;
                if ( !$is_same_group ) {
                    $is_big_gap ||=
                      (      $lines_above == 1
                          || $lines_above == 2 && $lines_below >= 4 )
                      && $col_want > $col + $short_pad * $factor;
                    $is_big_gap ||=
                      (      $lines_below == 1
                          || $lines_below == 2 && $lines_above >= 4 )
                      && $col > $col_want + $short_pad * $factor;
                }

# if match is limited by gap size, stop aligning at this level
                if ($is_big_gap) {
                    $blocking_level[$ng] = $lev - 1;
                }

# quit and restart if it cannot join this batch
                if (   $col_want > $col_max
                    || $col > $col_limit
                    || $is_big_gap
                    || $is_blocked )
                {

# remember the level of the first blocking token
                    if ( !defined( $blocking_level[$ng] ) ) {
                        $blocking_level[$ng] = $lev;
                    }

move_to_common_column(
                        {
                            rlines    => $rlines,
                            rgroups   => $rgroups,
                            rmax_move => $rmax_move,
                            ngb       => $ng_first,
                            nge       => $ng - 1,
                            itok      => $itok,
                            col_want  => $col_want,
                            raw_tok   => $raw_tok,
                        }
                    );
                    $ng_first        = $ng;
                    $col_want        = $col;
                    $col_limit       = $col_max;
                    $line_count_ng_m = $line_count_ng;
                    $jmax_m          = $jmax;
                    $it_stop_m       = $it_stop;
                    next;
                }

$line_count_ng_m += $line_count_ng;

# update the common column and limit
                if ( $col > $col_want )      { $col_want  = $col }
                if ( $col_max < $col_limit ) { $col_limit = $col_max }

} ## end loop over groups

if ( $ng_end > $ng_first ) {
                move_to_common_column(
                    {
                        rlines    => $rlines,
                        rgroups   => $rgroups,
                        rmax_move => $rmax_move,
                        ngb       => $ng_first,
                        nge       => $ng_end,
                        itok      => $itok,
                        col_want  => $col_want,
                        raw_tok   => $raw_tok,
                    }
                );
            }
        } ## end loop over tasks

return;
    } ## end sub do_left_to_right_sweep
}

sub delete_selected_tokens {

my ( $line_obj, $ridel ) = @_;

# $line_obj    is the line to be modified
    # $ridel       is a ref to list of indexes to be deleted

# remove an unused alignment token(s) to improve alignment chances

return if ( !defined($line_obj) || !defined($ridel) || !@{$ridel} );

my $jmax_old           = $line_obj->{'jmax'};
    my $rfields_old        = $line_obj->{'rfields'};
    my $rfield_lengths_old = $line_obj->{'rfield_lengths'};
    my $rpatterns_old      = $line_obj->{'rpatterns'};
    my $rtokens_old        = $line_obj->{'rtokens'};
    my $j_terminal_match   = $line_obj->{'j_terminal_match'};

use constant EXPLAIN_DELETE_SELECTED => 0;

local $LIST_SEPARATOR = '> <';
    EXPLAIN_DELETE_SELECTED && print <<EOM;
delete indexes: <@{$ridel}>
old jmax: $jmax_old
old tokens: <@{$rtokens_old}>
old patterns: <@{$rpatterns_old}>
old fields: <@{$rfields_old}>
old field_lengths: <@{$rfield_lengths_old}>
EOM

my $rfields_new        = [];
    my $rpatterns_new      = [];
    my $rtokens_new        = [];
    my $rfield_lengths_new = [];

# Convert deletion list to a hash to allow any order, multiple entries,
    # and avoid problems with index values out of range
    my %delete_me;
    @delete_me{ @{$ridel} } = (1) x scalar( @{$ridel} );

my $pattern_0      = $rpatterns_old->[0];
    my $field_0        = $rfields_old->[0];
    my $field_length_0 = $rfield_lengths_old->[0];
    push @{$rfields_new},        $field_0;
    push @{$rfield_lengths_new}, $field_length_0;
    push @{$rpatterns_new},      $pattern_0;

# Loop to either copy items or concatenate fields and patterns
    my $jmin_del;
    foreach my $j ( 0 .. $jmax_old - 1 ) {
        my $token        = $rtokens_old->[$j];
        my $field        = $rfields_old->[ $j + 1 ];
        my $field_length = $rfield_lengths_old->[ $j + 1 ];
        my $pattern      = $rpatterns_old->[ $j + 1 ];
        if ( !$delete_me{$j} ) {
            push @{$rtokens_new},        $token;
            push @{$rfields_new},        $field;
            push @{$rpatterns_new},      $pattern;
            push @{$rfield_lengths_new}, $field_length;
        }
        else {
            if ( !defined($jmin_del) ) { $jmin_del = $j }
            $rfields_new->[-1] .= $field;
            $rfield_lengths_new->[-1] += $field_length;
            $rpatterns_new->[-1] .= $pattern;
        }
    }

# ----- x ------ x ------ x ------
    #t      0        1        2        <- token indexing
    #f   0      1        2        3    <- field and pattern

my $jmax_new = @{$rfields_new} - 1;
    $line_obj->{'rtokens'}        = $rtokens_new;
    $line_obj->{'rpatterns'}      = $rpatterns_new;
    $line_obj->{'rfields'}        = $rfields_new;
    $line_obj->{'rfield_lengths'} = $rfield_lengths_new;
    $line_obj->{'jmax'}           = $jmax_new;

# The value of j_terminal_match will be incorrect if we delete tokens prior
    # to it. We will have to give up on aligning the terminal tokens if this
    # happens.
    if ( defined($j_terminal_match) && $jmin_del <= $j_terminal_match ) {
        $line_obj->{'j_terminal_match'} = undef;
    }

# update list type -
    if ( $line_obj->{'list_seqno'} ) {

## This works, but for efficiency see if we need to make a change:
        ## decide_if_list($line_obj);

# An existing list will still be a list but with possibly different
        # leading token
        my $old_list_type = $line_obj->{'list_type'};
        my $new_list_type = EMPTY_STRING;
        if ( $rtokens_new->[0] =~ /^(=>|,)/ ) {
            $new_list_type = $rtokens_new->[0];
        }
        if ( !$old_list_type || $old_list_type ne $new_list_type ) {
            decide_if_list($line_obj);
        }
    }

EXPLAIN_DELETE_SELECTED && print <<EOM;

new jmax: $jmax_new
new tokens: <@{$rtokens_new}>
new patterns: <@{$rpatterns_new}>
new fields: <@{$rfields_new}>
EOM
    return;
} ## end sub delete_selected_tokens

{    ## closure for sub decode_alignment_token

# This routine is called repeatedly for each token, so it needs to be
    # efficient.  We can speed things up by remembering the inputs and outputs
    # in a hash.
    my %decoded_token;

sub initialize_decode {

# We will re-initialize the hash for each file. Otherwise, there is
        # a danger that the hash can become arbitrarily large if a very large
        # number of files is processed at once.
        %decoded_token = ();
        return;
    } ## end sub initialize_decode

sub decode_alignment_token {

# Unpack the values packed in an alignment token
        #
        # Usage:
        #        my ( $raw_tok, $lev, $tag, $tok_count ) =
        #          decode_alignment_token($token);

# Alignment tokens have a trailing decimal level and optional tag (for
        # commas):
        # For example, the first comma in the following line
        #     sub banner  { crlf; report( shift, '/', shift ); crlf }
        # is decorated as follows:
        #    ,2+report-6  => (tok,lev,tag) =qw( ,   2   +report-6)

# An optional token count may be appended with a leading dot.
        # Currently this is only done for '=' tokens but this could change.
        # For example, consider the following line:
        #   $nport   = $port = shift || $name;
        # The first '=' may either be '=0' or '=0.1' [level 0, first equals]
        # The second '=' will be '=0.2' [level 0, second equals]
        my ($tok) = @_;

if ( defined( $decoded_token{$tok} ) ) {
            return @{ $decoded_token{$tok} };
        }

my ( $raw_tok, $lev, $tag, $tok_count ) = ( $tok, 0, EMPTY_STRING, 1 );
        if ( $tok =~ /^(\D+)(\d+)([^\.]*)(\.(\d+))?$/ ) {
            $raw_tok   = $1;
            $lev       = $2;
            $tag       = $3 if ($3);
            $tok_count = $5 if ($5);
        }
        my @vals = ( $raw_tok, $lev, $tag, $tok_count );
        $decoded_token{$tok} = \@vals;
        return @vals;
    } ## end sub decode_alignment_token
}

{    ## closure for sub delete_unmatched_tokens

my %is_assignment;
    my %keep_after_deleted_assignment;

BEGIN {
        my @q;

@q = qw(
          = **= += *= &= <<= &&=
          -= /= |= >>= ||= //=
          .= %= ^=
          x=
        );
        @is_assignment{@q} = (1) x scalar(@q);

# These tokens may be kept following an = deletion
        @q = qw(
          if unless or ||
        );
        @keep_after_deleted_assignment{@q} = (1) x scalar(@q);

} ## end BEGIN

sub delete_unmatched_tokens {
        my ( $rlines, $group_level ) = @_;

# This is a important first step in vertical alignment in which
        # we remove as many obviously un-needed alignment tokens as possible.
        # This will prevent them from interfering with the final alignment.

# Returns:
        my $max_lev_diff     = 0;    # used to avoid a call to prune_tree
        my $saw_side_comment = 0;    # used to avoid a call for side comments

# Handle no lines -- shouldn't happen
        return unless @{$rlines};

# Handle a single line
        if ( @{$rlines} == 1 ) {
            my $line   = $rlines->[0];
            my $jmax   = $line->{'jmax'};
            my $length = $line->{'rfield_lengths'}->[$jmax];
            $saw_side_comment = $length > 0;
            return ( $max_lev_diff, $saw_side_comment );
        }

# ignore hanging side comments in these operations
        my @filtered   = grep { !$_->{'is_hanging_side_comment'} } @{$rlines};
        my $rnew_lines = \@filtered;

$saw_side_comment = @filtered != @{$rlines};
        $max_lev_diff     = 0;

# nothing to do if all lines were hanging side comments
        my $jmax = @{$rnew_lines} - 1;
        return ( $max_lev_diff, $saw_side_comment ) if ( $jmax < 0 );

#----------------------------------------------------
        # Create a hash of alignment token info for each line
        #----------------------------------------------------
        ( my $rline_hashes, my $requals_info, $saw_side_comment, $max_lev_diff )
          = make_alignment_info( $group_level, $rnew_lines, $saw_side_comment );

#------------------------------------------------------------
        # Find independent subgroups of lines.  Neighboring subgroups
        # do not have a common alignment token.
        #------------------------------------------------------------
        my @subgroups;
        push @subgroups, [ 0, $jmax ];
        foreach my $jl ( 0 .. $jmax - 1 ) {
            if ( $rnew_lines->[$jl]->{'end_group'} ) {
                $subgroups[-1]->[1] = $jl;
                push @subgroups, [ $jl + 1, $jmax ];
            }
        }

#-----------------------------------------------------------
        # PASS 1 over subgroups to remove unmatched alignment tokens
        #-----------------------------------------------------------
        delete_unmatched_tokens_main_loop(
            $group_level,  $rnew_lines, \@subgroups,
            $rline_hashes, $requals_info
        );

#----------------------------------------------------------------
        # PASS 2: Construct a tree of matched lines and delete some small
        # deeper levels of tokens.  They also block good alignments.
        #----------------------------------------------------------------
        prune_alignment_tree($rnew_lines) if ($max_lev_diff);

#--------------------------------------------
        # PASS 3: compare all lines for common tokens
        #--------------------------------------------
        match_line_pairs( $rlines, $rnew_lines, \@subgroups, $group_level );

return ( $max_lev_diff, $saw_side_comment );
    } ## end sub delete_unmatched_tokens

sub make_alignment_info {

my ( $group_level, $rnew_lines, $saw_side_comment ) = @_;

#------------------------------------------------------------
        # Loop to create a hash of alignment token info for each line
        #------------------------------------------------------------
        my $rline_hashes = [];
        my @equals_info;
        my @line_info;    # no longer used
        my $jmax         = @{$rnew_lines} - 1;
        my $max_lev_diff = 0;
        foreach my $line ( @{$rnew_lines} ) {
            my $rhash     = {};
            my $rtokens   = $line->{'rtokens'};
            my $rpatterns = $line->{'rpatterns'};
            my $i         = 0;
            my ( $i_eq, $tok_eq, $pat_eq );
            my ( $lev_min, $lev_max );
            foreach my $tok ( @{$rtokens} ) {
                my ( $raw_tok, $lev, $tag, $tok_count ) =
                  decode_alignment_token($tok);

if ( $tok ne '#' ) {
                    if ( !defined($lev_min) ) {
                        $lev_min = $lev;
                        $lev_max = $lev;
                    }
                    else {
                        if ( $lev < $lev_min ) { $lev_min = $lev }
                        if ( $lev > $lev_max ) { $lev_max = $lev }
                    }
                }
                else {
                    if ( !$saw_side_comment ) {
                        my $length = $line->{'rfield_lengths'}->[ $i + 1 ];
                        $saw_side_comment ||= $length;
                    }
                }

# 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 '=' ) {

if ( $lev eq $group_level ) {
                        $i_eq   = $i;
                        $tok_eq = $tok;
                        $pat_eq = $rpatterns->[$i];
                    }
                }
                $i++;
            }
            push @{$rline_hashes}, $rhash;
            push @equals_info,     [ $i_eq,    $tok_eq, $pat_eq ];
            push @line_info,       [ $lev_min, $lev_max ];
            if ( defined($lev_min) ) {
                my $lev_diff = $lev_max - $lev_min;
                if ( $lev_diff > $max_lev_diff ) { $max_lev_diff = $lev_diff }
            }
        }

#----------------------------------------------------
        # Loop to compare each line pair and remember matches
        #----------------------------------------------------
        my $rtok_hash = {};
        my $nr        = 0;
        foreach my $jl ( 0 .. $jmax - 1 ) {
            my $nl = $nr;
            $nr = 0;
            my $jr      = $jl + 1;
            my $rhash_l = $rline_hashes->[$jl];
            my $rhash_r = $rline_hashes->[$jr];
            foreach my $tok ( keys %{$rhash_l} ) {
                if ( defined( $rhash_r->{$tok} ) ) {
                    my $il = $rhash_l->{$tok}->[0];
                    my $ir = $rhash_r->{$tok}->[0];
                    $rhash_l->{$tok}->[2] = $ir;
                    $rhash_r->{$tok}->[1] = $il;
                    if ( $tok ne '#' ) {
                        push @{ $rtok_hash->{$tok} }, ( $jl, $jr );
                        $nr++;
                    }
                }
            }

# Set a line break if no matching tokens between these lines
            # (this is not strictly necessary now but does not hurt)
            if ( $nr == 0 && $nl > 0 ) {
                $rnew_lines->[$jl]->{'end_group'} = 1;
            }

# Also set a line break if both lines have simple equals but with
            # different leading characters in patterns.  This check is similar
            # to one in sub check_match, and will prevent sub
            # prune_alignment_tree from removing alignments which otherwise
            # should be kept. This fix is rarely needed, but it can
            # occasionally improve formatting.
            # For example:
            #     my $name = $this->{Name};
            #     $type = $this->ctype($genlooptype) if defined $genlooptype;
            #     my $declini = ( $asgnonly ? ""          : "\t$type *" );
            #     my $cast    = ( $type     ? "($type *)" : "" );
            # The last two lines start with 'my' and will not match the
            # previous line starting with $type, so we do not want
            # prune_alignment tree to delete their ? : alignments at a deeper
            # level.
            my ( $i_eq_l, $tok_eq_l, $pat_eq_l ) = @{ $equals_info[$jl] };
            my ( $i_eq_r, $tok_eq_r, $pat_eq_r ) = @{ $equals_info[$jr] };
            if ( defined($i_eq_l) && defined($i_eq_r) ) {

# Also, do not align equals across a change in ci level
                my $ci_jump = $rnew_lines->[$jl]->{'ci_level'} !=
                  $rnew_lines->[$jr]->{'ci_level'};

if (
                       $tok_eq_l eq $tok_eq_r
                    && $i_eq_l == 0
                    && $i_eq_r == 0
                    && ( substr( $pat_eq_l, 0, 1 ) ne substr( $pat_eq_r, 0, 1 )
                        || $ci_jump )
                  )
                {
                    $rnew_lines->[$jl]->{'end_group'} = 1;
                }
            }
        }
        return ( $rline_hashes, \@equals_info, $saw_side_comment,
            $max_lev_diff );
    } ## end sub make_alignment_info

sub delete_unmatched_tokens_main_loop {

my (
            $group_level,  $rnew_lines, $rsubgroups,
            $rline_hashes, $requals_info
        ) = @_;

#--------------------------------------------------------------
        # Main loop over subgroups to remove unmatched alignment tokens
        #--------------------------------------------------------------

# flag to allow skipping pass 2 - not currently used
        my $saw_large_group;

my $has_terminal_match = $rnew_lines->[-1]->{'j_terminal_match'};

foreach my $item ( @{$rsubgroups} ) {
            my ( $jbeg, $jend ) = @{$item};

my $nlines = $jend - $jbeg + 1;

#---------------------------------------------------
            # Look for complete if/elsif/else and ternary blocks
            #---------------------------------------------------

# We are looking for a common '$dividing_token' like these:

#    if    ( $b and $s ) { $p->{'type'} = 'a'; }
            #    elsif ($b)          { $p->{'type'} = 'b'; }
            #    elsif ($s)          { $p->{'type'} = 's'; }
            #    else                { $p->{'type'} = ''; }
            #                        ^----------- dividing_token

#   my $severity =
            #      !$routine                     ? '[PFX]'
            #     : $routine =~ /warn.*_d\z/     ? '[DS]'
            #     : $routine =~ /ck_warn/        ? 'W'
            #     : $routine =~ /ckWARN\d*reg_d/ ? 'S'
            #     : $routine =~ /ckWARN\d*reg/   ? 'W'
            #     : $routine =~ /vWARN\d/        ? '[WDS]'
            #     :                                '[PFX]';
            #                                    ^----------- dividing_token

# Only look for groups which are more than 2 lines long.  Two lines
            # can get messed up doing this, probably due to the various
            # two-line rules.

my $dividing_token;
            my %token_line_count;
            if ( $nlines > 2 ) {

foreach my $jj ( $jbeg .. $jend ) {
                    my %seen;
                    my $line    = $rnew_lines->[$jj];
                    my $rtokens = $line->{'rtokens'};
                    foreach my $tok ( @{$rtokens} ) {
                        if ( !$seen{$tok} ) {
                            $seen{$tok}++;
                            $token_line_count{$tok}++;
                        }
                    }
                }

foreach my $tok ( keys %token_line_count ) {
                    if ( $token_line_count{$tok} == $nlines ) {
                        if (   substr( $tok, 0, 1 ) eq '?'
                            || substr( $tok, 0, 1 ) eq '{'
                            && $tok =~ /^\{\d+if/ )
                        {
                            $dividing_token = $tok;
                            last;
                        }
                    }
                }
            }

#-------------------------------------------------------------
            # Loop over subgroup lines to remove unwanted alignment tokens
            #-------------------------------------------------------------
            foreach my $jj ( $jbeg .. $jend ) {
                my $line    = $rnew_lines->[$jj];
                my $rtokens = $line->{'rtokens'};
                my $rhash   = $rline_hashes->[$jj];
                my $i_eq    = $requals_info->[$jj]->[0];
                my @idel;
                my $imax = @{$rtokens} - 2;
                my $delete_above_level;
                my $deleted_assignment_token;

my $saw_dividing_token = EMPTY_STRING;
                $saw_large_group ||= $nlines > 2 && $imax > 1;

# Loop over all alignment tokens
                foreach my $i ( 0 .. $imax ) {
                    my $tok = $rtokens->[$i];
                    next if ( $tok eq '#' );    # shouldn't happen
                    my ( $iii, $il, $ir, $raw_tok, $lev, $tag, $tok_count ) =
                      @{ $rhash->{$tok} };

#------------------------------------------------------
                    # Here is the basic RULE: remove an unmatched alignment
                    # which does not occur in the surrounding lines.
                    #------------------------------------------------------
                    my $delete_me = !defined($il) && !defined($ir);

# Apply any user controls. Note that not all lines pass
                    # this way so they have to be applied elsewhere too.
                    my $align_ok = 1;
                    if (%valign_control_hash) {
                        $align_ok = $valign_control_hash{$raw_tok};
                        $align_ok = $valign_control_default
                          unless defined($align_ok);
                        $delete_me ||= !$align_ok;
                    }

# But now we modify this with exceptions...

# EXCEPTION 1: If we are in a complete ternary or
                    # if/elsif/else group, and this token is not on every line
                    # of the group, should we delete it to preserve overall
                    # alignment?
                    if ($dividing_token) {
                        if ( $token_line_count{$tok} >= $nlines ) {
                            $saw_dividing_token ||= $tok eq $dividing_token;
                        }
                        else {

# For shorter runs, delete toks to save alignment.
                            # For longer runs, keep toks after the '{' or '?'
                            # to allow sub-alignments within braces.  The
                            # number 5 lines is arbitrary but seems to work ok.
                            $delete_me ||=
                              ( $nlines < 5 || !$saw_dividing_token );
                        }
                    }

# EXCEPTION 2: 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($delete_above_level) ) {
                        if ( $lev > $delete_above_level ) {
                            $delete_me ||= 1;
                        }
                        else { $delete_above_level = undef }
                    }

# EXCEPTION 3: Remove all but certain tokens after an
                    # assignment deletion.
                    if (
                        $deleted_assignment_token
                        && ( $lev > $group_level
                            || !$keep_after_deleted_assignment{$raw_tok} )
                      )
                    {
                        $delete_me ||= 1;
                    }

# EXCEPTION 4: Do not touch the first line of a 2 line
                    # terminal match, such as below, because j_terminal has
                    # already been set.
                    #    if ($tag) { $tago = "<$tag>"; $tagc = "</$tag>"; }
                    #    else      { $tago = $tagc = ''; }
                    # But see snippets 'else1.t' and 'else2.t'
                    $delete_me = 0
                      if ( $jj == $jbeg
                        && $has_terminal_match
                        && $nlines == 2 );

# EXCEPTION 5: misc additional rules for commas and equals
                    if ( $delete_me && $tok_count == 1 ) {

# okay to delete second and higher copies of a token

# for a comma...
                        if ( $raw_tok eq ',' ) {

# Do not delete commas before an equals
                            $delete_me = 0
                              if ( defined($i_eq) && $i < $i_eq );

# Do not delete line-level commas
                            $delete_me = 0 if ( $lev <= $group_level );
                        }

# For an assignment at group level..
                        if (   $is_assignment{$raw_tok}
                            && $lev == $group_level )
                        {

# Do not delete if it is the last alignment of
                            # multiple tokens; this will prevent some
                            # undesirable alignments
                            if ( $imax > 0 && $i == $imax ) {
                                $delete_me = 0;
                            }

# Otherwise, set a flag to delete most
                            # remaining tokens
                            else { $deleted_assignment_token = $raw_tok }
                        }
                    }

# Do not let a user exclusion be reactivated by above rules
                    $delete_me ||= !$align_ok;

#------------------------------------
                    # Add this token to the deletion list
                    #------------------------------------
                    if ($delete_me) {
                        push @idel, $i;

# update deletion propagation flags
                        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;
                            }
                        }
                    }
                }    # End loop over alignment tokens

# Process all deletion requests for this line
                if (@idel) {
                    delete_selected_tokens( $line, \@idel );
                }
            }    # End loop over lines
        } ## end main loop over subgroups

return;
    } ## end sub delete_unmatched_tokens_main_loop
}

sub match_line_pairs {
    my ( $rlines, $rnew_lines, $rsubgroups, $group_level ) = @_;

# Compare each pair of lines and save information about common matches
    # $rlines     = list of lines including hanging side comments
    # $rnew_lines = list of lines without any hanging side comments
    # $rsubgroups = list of subgroups of the new lines

# TODO:
    # Maybe change: imax_pair => pair_match_info = ref to array
    #  = [$imax_align, $rMsg, ... ]
    #  This may eventually have multi-level match info

# Previous line vars
    my ( $line_m, $rtokens_m, $rpatterns_m, $rfield_lengths_m, $imax_m,
        $list_type_m, $ci_level_m );

# Current line vars
    my ( $line, $rtokens, $rpatterns, $rfield_lengths, $imax, $list_type,
        $ci_level );

# loop over subgroups
    foreach my $item ( @{$rsubgroups} ) {
        my ( $jbeg, $jend ) = @{$item};
        my $nlines = $jend - $jbeg + 1;
        next if ( $nlines <= 1 );

# loop over lines in a subgroup
        foreach my $jj ( $jbeg .. $jend ) {

$line_m           = $line;
            $rtokens_m        = $rtokens;
            $rpatterns_m      = $rpatterns;
            $rfield_lengths_m = $rfield_lengths;
            $imax_m           = $imax;
            $list_type_m      = $list_type;
            $ci_level_m       = $ci_level;

$line           = $rnew_lines->[$jj];
            $rtokens        = $line->{'rtokens'};
            $rpatterns      = $line->{'rpatterns'};
            $rfield_lengths = $line->{'rfield_lengths'};
            $imax           = @{$rtokens} - 2;
            $list_type      = $line->{'list_type'};
            $ci_level       = $line->{'ci_level'};

# nothing to do for first line
            next if ( $jj == $jbeg );

my $ci_jump = $ci_level - $ci_level_m;

my $imax_min = $imax_m < $imax ? $imax_m : $imax;

my $imax_align = -1;

# find number of leading common tokens

#---------------------------------
            # No match to hanging side comment
            #---------------------------------
            if ( $line->{'is_hanging_side_comment'} ) {

# Should not get here; HSC's have been filtered out
                $imax_align = -1;
            }

#-----------------------------
            # Handle comma-separated lists
            #-----------------------------
            elsif ( $list_type && $list_type eq $list_type_m ) {

# do not align lists across a ci jump with new list method
                if ($ci_jump) { $imax_min = -1 }

my $i_nomatch = $imax_min + 1;
                foreach my $i ( 0 .. $imax_min ) {
                    my $tok   = $rtokens->[$i];
                    my $tok_m = $rtokens_m->[$i];
                    if ( $tok ne $tok_m ) {
                        $i_nomatch = $i;
                        last;
                    }
                }

$imax_align = $i_nomatch - 1;
            }

#-----------------
            # Handle non-lists
            #-----------------
            else {
                my $i_nomatch = $imax_min + 1;
                foreach my $i ( 0 .. $imax_min ) {
                    my $tok   = $rtokens->[$i];
                    my $tok_m = $rtokens_m->[$i];
                    if ( $tok ne $tok_m ) {
                        $i_nomatch = $i;
                        last;
                    }

my $pat   = $rpatterns->[$i];
                    my $pat_m = $rpatterns_m->[$i];

# VSN PATCH: allow numbers to match quotes
                    if ( $pat_m ne $pat ) {
                        $pat   =~ tr/n/Q/;
                        $pat_m =~ tr/n/Q/;
                    }

# If patterns don't match, we have to be careful...
                    if ( $pat_m ne $pat ) {
                        my $pad =
                          $rfield_lengths->[$i] - $rfield_lengths_m->[$i];
                        my $match_code = compare_patterns(
                            {
                                group_level => $group_level,
                                tok         => $tok,
                                tok_m       => $tok_m,
                                pat         => $pat,
                                pat_m       => $pat_m,
                                pad         => $pad,
                            }
                        );
                        if ($match_code) {
                            if    ( $match_code == 1 ) { $i_nomatch = $i }
                            elsif ( $match_code == 2 ) { $i_nomatch = 0 }
                            else                       { }                  ##ok
                            last;
                        }
                    }
                }
                $imax_align = $i_nomatch - 1;
            }

$line_m->{'imax_pair'} = $imax_align;

} ## end loop over lines

# Put fence at end of subgroup
        $line->{'imax_pair'} = -1;

} ## end loop over subgroups

# if there are hanging side comments, propagate the pair info down to them
    # so that lines can just look back one line for their pair info.
    if ( @{$rlines} > @{$rnew_lines} ) {
        my $last_pair_info = -1;
        foreach my $line_t ( @{$rlines} ) {
            if ( $line_t->{'is_hanging_side_comment'} ) {
                $line_t->{'imax_pair'} = $last_pair_info;
            }
            else {
                $last_pair_info = $line_t->{'imax_pair'};
            }
        }
    }
    return;
} ## end sub match_line_pairs

sub compare_patterns {

my ($rcall_hash) = @_;

my $group_level = $rcall_hash->{group_level};
    my $tok         = $rcall_hash->{tok};
    my $tok_m       = $rcall_hash->{tok_m};
    my $pat         = $rcall_hash->{pat};
    my $pat_m       = $rcall_hash->{pat_m};
    my $pad         = $rcall_hash->{pad};

# helper routine for sub match_line_pairs to decide if patterns in two
    # lines match well enough..Given
    #   $tok_m, $pat_m = token and pattern of first line
    #   $tok, $pat     = token and pattern of second line
    #   $pad           = 0 if no padding is needed, !=0 otherwise
    # return code:
    #   0 = patterns match, continue
    #   1 = no match
    #   2 = no match, and lines do not match at all

my $GoToMsg     = EMPTY_STRING;
    my $return_code = 0;

use constant EXPLAIN_COMPARE_PATTERNS => 0;

my ( $alignment_token, $lev, $tag, $tok_count ) =
      decode_alignment_token($tok);

# We have to be very careful about aligning commas
    # when the pattern's don't match, because it can be
    # worse to create an alignment where none is needed
    # than to omit one.  Here's an example where the ','s
    # are not in named containers.  The first line below
    # should not match the next two:
    #   ( $a, $b ) = ( $b, $r );
    #   ( $x1, $x2 ) = ( $x2 - $q * $x1, $x1 );
    #   ( $y1, $y2 ) = ( $y2 - $q * $y1, $y1 );
    if ( $alignment_token eq ',' ) {

# do not align commas unless they are in named
        # containers
        if ( $tok !~ /[A-Za-z]/ ) {
            $return_code = 1;
            $GoToMsg     = "do not align commas in unnamed containers";
        }
        else {
            $return_code = 0;
        }
    }

# do not align parens unless patterns match;
    # large ugly spaces can occur in math expressions.
    elsif ( $alignment_token eq '(' ) {

# But we can allow a match if the parens don't
        # require any padding.
        if ( $pad != 0 ) {
            $return_code = 1;
            $GoToMsg     = "do not align '(' unless patterns match or pad=0";
        }
        else {
            $return_code = 0;
        }
    }

# Handle an '=' alignment with different patterns to
    # the left.
    elsif ( $alignment_token eq '=' ) {

# It is best to be a little restrictive when
        # aligning '=' tokens.  Here is an example of
        # two lines that we will not align:
        #       my $variable=6;
        #       $bb=4;
        # The problem is that one is a 'my' declaration,
        # and the other isn't, so they're not very similar.
        # We will filter these out by comparing the first
        # letter of the pattern.  This is crude, but works
        # well enough.
        if ( substr( $pat_m, 0, 1 ) ne substr( $pat, 0, 1 ) ) {
            $GoToMsg     = "first character before equals differ";
            $return_code = 1;
        }

# The introduction of sub 'prune_alignment_tree'
        # enabled alignment of lists left of the equals with
        # other scalar variables. For example:
        # my ( $D, $s, $e ) = @_;
        # my $d             = length $D;
        # my $c             = $e - $s - $d;

# But this would change formatting of a lot of scripts,
        # so for now we prevent alignment of comma lists on the
        # left with scalars on the left.  We will also prevent
        # any partial alignments.

# set return code 2 if the = is at line level, but
        # set return code 1 if the = is below line level, i.e.
        #  sub new { my ( $p, $v ) = @_; bless \$v, $p }
        #  sub iter { my ($x) = @_; return undef if $$x < 0; return $$x--; }

elsif ( ( index( $pat_m, ',' ) >= 0 ) ne ( index( $pat, ',' ) >= 0 ) ) {
            $GoToMsg     = "mixed commas/no-commas before equals";
            $return_code = 1;
            if ( $lev eq $group_level ) {
                $return_code = 2;
            }
        }
        else {
            $return_code = 0;
        }
    }
    else {
        $return_code = 0;
    }

EXPLAIN_COMPARE_PATTERNS
      && $return_code
      && print {*STDOUT} "no match because $GoToMsg\n";

return $return_code;

} ## end sub compare_patterns

sub fat_comma_to_comma {
    my ($str) = @_;

# We are changing '=>' to ',' and removing any trailing decimal count
    # because currently fat commas have a count and commas do not.
    # For example, we will change '=>2+{-3.2' into ',2+{-3'
    if ( $str =~ /^=>([^\.]*)/ ) { $str = ',' . $1 }
    return $str;
} ## end sub fat_comma_to_comma

sub get_line_token_info {

# scan lines of tokens and return summary information about the range of
    # levels and patterns.
    my ($rlines) = @_;

# First scan to check monotonicity. Here is an example of several
    # lines which are monotonic. The = is the lowest level, and
    # the commas are all one level deeper. So this is not nonmonotonic.
    #  $$d{"weeks"}   = [ "w",  "wk",  "wks", "week", "weeks" ];
    #  $$d{"days"}    = [ "d",  "day", "days" ];
    #  $$d{"hours"}   = [ "h",  "hr",  "hrs", "hour", "hours" ];
    my @all_token_info;
    my $all_monotonic = 1;
    foreach my $jj ( 0 .. @{$rlines} - 1 ) {
        my ($line) = $rlines->[$jj];
        my $rtokens = $line->{'rtokens'};
        my $last_lev;
        my $is_monotonic = 1;
        my $i            = -1;
        foreach my $tok ( @{$rtokens} ) {
            $i++;
            my ( $raw_tok, $lev, $tag, $tok_count ) =
              decode_alignment_token($tok);
            push @{ $all_token_info[$jj] },
              [ $raw_tok, $lev, $tag, $tok_count ];
            last if ( $tok eq '#' );
            if ( $i > 0 && $lev < $last_lev ) { $is_monotonic = 0 }
            $last_lev = $lev;
        }
        if ( !$is_monotonic ) { $all_monotonic = 0 }
    }

my $rline_values = [];
    foreach my $jj ( 0 .. @{$rlines} - 1 ) {
        my ($line) = $rlines->[$jj];

my $rtokens = $line->{'rtokens'};
        my $i       = -1;
        my ( $lev_min, $lev_max );
        my $token_pattern_max = EMPTY_STRING;
        my %saw_level;
        my $is_monotonic = 1;

# find the index of the last token before the side comment
        my $imax      = @{$rtokens} - 2;
        my $imax_true = $imax;

# If the entire group is monotonic, and the line ends in a comma list,
        # walk it back to the first such comma. this will have the effect of
        # making all trailing ragged comma lists match in the prune tree
        # routine.  these trailing comma lists can better be handled by later
        # alignment rules.

# Treat fat commas the same as commas here by converting them to
        # commas.  This will improve the chance of aligning the leading parts
        # of ragged lists.

my $tok_end = fat_comma_to_comma( $rtokens->[$imax] );
        if ( $all_monotonic && $tok_end =~ /^,/ ) {
            my $ii = $imax - 1;
            while ( $ii >= 0
                && fat_comma_to_comma( $rtokens->[$ii] ) eq $tok_end )
            {
                $imax = $ii;
                $ii--;
            }
        }

# make a first pass to find level range
        my $last_lev;
        foreach my $tok ( @{$rtokens} ) {
            $i++;
            last if ( $i > $imax );
            last if ( $tok eq '#' );
            my ( $raw_tok, $lev, $tag, $tok_count ) =
              @{ $all_token_info[$jj]->[$i] };

last if ( $tok eq '#' );
            $token_pattern_max .= $tok;
            $saw_level{$lev}++;
            if ( !defined($lev_min) ) {
                $lev_min = $lev;
                $lev_max = $lev;
            }
            else {
                if ( $lev < $lev_min )  { $lev_min      = $lev; }
                if ( $lev > $lev_max )  { $lev_max      = $lev; }
                if ( $lev < $last_lev ) { $is_monotonic = 0 }
            }
            $last_lev = $lev;
        }

# handle no levels
        my $rtoken_patterns = {};
        my $rtoken_indexes  = {};
        my @levs            = sort { $a <=> $b } keys %saw_level;
        if ( !defined($lev_min) ) {
            $lev_min                     = -1;
            $lev_max                     = -1;
            $levs[0]                     = -1;
            $rtoken_patterns->{$lev_min} = EMPTY_STRING;
            $rtoken_indexes->{$lev_min}  = [];
        }

# handle one level
        elsif ( $lev_max == $lev_min ) {
            $rtoken_patterns->{$lev_max} = $token_pattern_max;
            $rtoken_indexes->{$lev_max}  = [ ( 0 .. $imax ) ];
        }

# handle multiple levels
        else {
            $rtoken_patterns->{$lev_max} = $token_pattern_max;
            $rtoken_indexes->{$lev_max}  = [ ( 0 .. $imax ) ];

my $lev_top = pop @levs;    # already did max level
            my $itok    = -1;
            foreach my $tok ( @{$rtokens} ) {
                $itok++;
                last if ( $itok > $imax );
                my ( $raw_tok, $lev, $tag, $tok_count ) =
                  @{ $all_token_info[$jj]->[$itok] };
                last if ( $raw_tok eq '#' );
                foreach my $lev_test (@levs) {
                    next if ( $lev > $lev_test );
                    $rtoken_patterns->{$lev_test} .= $tok;
                    push @{ $rtoken_indexes->{$lev_test} }, $itok;
                }
            }
            push @levs, $lev_top;
        }

push @{$rline_values},
          [
            $lev_min,        $lev_max,      $rtoken_patterns, \@levs,
            $rtoken_indexes, $is_monotonic, $imax_true,       $imax,
          ];

# debug
        0 && do {
            local $LIST_SEPARATOR = ')(';
            print "lev_min=$lev_min, lev_max=$lev_max, levels=(@levs)\n";
            foreach my $key ( sort keys %{$rtoken_patterns} ) {
                print "$key => $rtoken_patterns->{$key}\n";
                print "$key => @{$rtoken_indexes->{$key}}\n";
            }
        };
    } ## end loop over lines
    return ( $rline_values, $all_monotonic );
} ## end sub get_line_token_info

sub prune_alignment_tree {
    my ($rlines) = @_;
    my $jmax = @{$rlines} - 1;
    return if ( $jmax <= 0 );

# Vertical alignment in perltidy is done as an iterative process.  The
    # starting point is to mark all possible alignment tokens ('=', ',', '=>',
    # etc) for vertical alignment.  Then we have to delete all alignments
    # which, if actually made, would detract from overall alignment.  This
    # is done in several phases of which this is one.

# In this routine we look at the alignments of a group of lines as a
    # hierarchical tree.  We will 'prune' the tree to limited depths if that
    # will improve overall alignment at the lower depths.
    # For each line we will be looking at its alignment patterns down to
    # different fixed depths. For each depth, we include all lower depths and
    # ignore all higher depths.  We want to see if we can get alignment of a
    # larger group of lines if we ignore alignments at some lower depth.
    # Here is an # example:

# for (
    #     [ '$var',     sub { join $_, "bar" },            0, "bar" ],
    #     [ 'CONSTANT', sub { join "foo", "bar" },         0, "bar" ],
    #     [ 'CONSTANT', sub { join "foo", "bar", 3 },      1, "barfoo3" ],
    #     [ '$myvar',   sub { my $var; join $var, "bar" }, 0, "bar" ],
    # );

# In the above example, all lines have three commas at the lowest depth
    # (zero), so if there were no other alignments, these lines would all
    # align considering only the zero depth alignment token.  But some lines
    # have additional comma alignments at the next depth, so we need to decide
    # if we should drop those to keep the top level alignments, or keep those
    # for some additional low level alignments at the expense losing some top
    # level alignments.  In this case we will drop the deeper level commas to
    # keep the entire collection aligned.  But in some cases the decision could
    # go the other way.

# The tree for this example at the zero depth has one node containing
    # all four lines, since they are identical at zero level (three commas).
    # At depth one, there are three 'children' nodes, namely:
    # - lines 1 and 2, which have a single comma in the 'sub' at depth 1
    # - line 3, which has 2 commas at depth 1
    # - line4, which has a ';' and a ',' at depth 1
    # There are no deeper alignments in this example.
    # so the tree structure for this example is:
    #
    #    depth 0         depth 1      depth 2
    #    [lines 1-4] --  [line 1-2] -  (empty)
    #                 |  [line 3]   -  (empty)
    #                 |  [line 4]   -  (empty)

# We can carry this to any depth, but it is not really useful to go below
    # depth 2. To cleanly stop there, we will consider depth 2 to contain all
    # alignments at depth >=2.

use constant EXPLAIN_PRUNE => 0;

#-------------------------------------------------------------------
    # Prune Tree Step 1. Start by scanning the lines and collecting info
    #-------------------------------------------------------------------

# Note that the caller had this info but we have to redo this now because
    # alignment tokens may have been deleted.
    my ( $rline_values, $all_monotonic ) = get_line_token_info($rlines);

# If all the lines have levels which increase monotonically from left to
    # right, then the sweep-left-to-right pass can do a better job of alignment
    # than pruning, and without deleting alignments.
    return if ($all_monotonic);

# Contents of $rline_values
    #   [
    #     $lev_min,        $lev_max,      $rtoken_patterns, \@levs,
    #     $rtoken_indexes, $is_monotonic, $imax_true,       $imax,
    #   ];

# We can work to any depth, but there is little advantage to working
    # to a a depth greater than 2
    my $MAX_DEPTH = 2;

# This arrays will hold the tree of alignment tokens at different depths
    # for these lines.
    my @match_tree;

# Tree nodes contain these values:
    # $match_tree[$depth] = [$jbeg, $jend, $n_parent, $level, $pattern,
    #                        $nc_beg_p, $nc_end_p, $rindexes];
    # where
    #      $depth = 0,1,2 = index of depth of the match

#  $jbeg beginning index j of the range of lines in this match
    #  $jend ending index j of the range of lines in this match
    #  $n_parent = index of the containing group at $depth-1, if it exists
    #  $level = actual level of code being matched in this group
    #  $pattern = alignment pattern being matched
    #  $nc_beg_p = first child
    #  $nc_end_p = last child
    #  $rindexes = ref to token indexes

# the patterns and levels of the current group being formed at each depth
    my ( @token_patterns_current, @levels_current, @token_indexes_current );

# the patterns and levels of the next line being tested at each depth
    my ( @token_patterns_next, @levels_next, @token_indexes_next );

#-----------------------------------------------------------
    # define a recursive worker subroutine for tree construction
    #-----------------------------------------------------------

# This is a recursive routine which is called if a match condition changes
    # at any depth when a new line is encountered.  It ends the match node
    # which changed plus all deeper nodes attached to it.
    my $end_node;
    $end_node = sub {
        my ( $depth, $jl, $n_parent ) = @_;

# $depth is the tree depth
        # $jl is the  index of the line
        # $n_parent is index of the parent node of this node

return if ( $depth > $MAX_DEPTH );

# end any current group at this depth
        if (   $jl >= 0
            && defined( $match_tree[$depth] )
            && @{ $match_tree[$depth] }
            && defined( $levels_current[$depth] ) )
        {
            $match_tree[$depth]->[-1]->[1] = $jl;
        }

# Define the index of the node we will create below
        my $ng_self = 0;
        if ( defined( $match_tree[$depth] ) ) {
            $ng_self = @{ $match_tree[$depth] };
        }

# end any next deeper child node(s)
        $end_node->( $depth + 1, $jl, $ng_self );

# update the levels being matched
        $token_patterns_current[$depth] = $token_patterns_next[$depth];
        $token_indexes_current[$depth]  = $token_indexes_next[$depth];
        $levels_current[$depth]         = $levels_next[$depth];

# Do not start a new group at this level if it is not being used
        if ( !defined( $levels_next[$depth] )
            || $depth > 0
            && $levels_next[$depth] <= $levels_next[ $depth - 1 ] )
        {
            return;
        }

# Create a node for the next group at this depth. We initially assume
        # that it will continue to $jmax, and correct that later if the node
        # ends earlier.
        push @{ $match_tree[$depth] },
          [
            $jl + 1, $jmax, $n_parent, $levels_current[$depth],
            $token_patterns_current[$depth],
            undef, undef, $token_indexes_current[$depth],
          ];

return;
    };    ## end sub end_node

#-----------------------------------------------------
    # Prune Tree Step 2. Loop to form the tree of matches.
    #-----------------------------------------------------
    foreach my $jp ( 0 .. $jmax ) {

# working with two adjacent line indexes, 'm'=minus, 'p'=plus
        my $jm = $jp - 1;

# Pull out needed values for the next line
        my ( $lev_min, $lev_max, $rtoken_patterns, $rlevs, $rtoken_indexes,
            $is_monotonic, $imax_true, $imax )
          = @{ $rline_values->[$jp] };

# Transfer levels and patterns for this line to the working arrays.
        # If the number of levels differs from our chosen MAX_DEPTH ...
        # if fewer than MAX_DEPTH: leave levels at missing depths undefined
        # if more than MAX_DEPTH: set the MAX_DEPTH level to be the maximum
        @levels_next = @{$rlevs}[ 0 .. $MAX_DEPTH ];
        if ( @{$rlevs} > $MAX_DEPTH ) {
            $levels_next[$MAX_DEPTH] = $rlevs->[-1];
        }
        my $depth = 0;
        foreach my $item (@levels_next) {
            $token_patterns_next[$depth] =
              defined($item) ? $rtoken_patterns->{$item} : undef;
            $token_indexes_next[$depth] =
              defined($item) ? $rtoken_indexes->{$item} : undef;
            $depth++;
        }

# Look for a change in match groups...

# Initialize on the first line
        if ( $jp == 0 ) {
            my $n_parent;
            $end_node->( 0, $jm, $n_parent );
        }

# End groups if a hard flag has been set
        elsif ( $rlines->[$jm]->{'end_group'} ) {
            my $n_parent;
            $end_node->( 0, $jm, $n_parent );
        }

# Continue at hanging side comment
        elsif ( $rlines->[$jp]->{'is_hanging_side_comment'} ) {
            next;
        }

# Otherwise see if anything changed and update the tree if so
        else {
            foreach my $dep ( 0 .. $MAX_DEPTH ) {

my $def_current = defined( $token_patterns_current[$dep] );
                my $def_next    = defined( $token_patterns_next[$dep] );
                last if ( !$def_current && !$def_next );
                if (   !$def_current
                    || !$def_next
                    || $token_patterns_current[$dep] ne
                    $token_patterns_next[$dep] )
                {
                    my $n_parent;
                    if ( $dep > 0 && defined( $match_tree[ $dep - 1 ] ) ) {
                        $n_parent = @{ $match_tree[ $dep - 1 ] } - 1;
                    }
                    $end_node->( $dep, $jm, $n_parent );
                    last;
                }
            }
        }
    } ## end loop to form tree of matches

#---------------------------------------------------------
    # Prune Tree Step 3. Make links from parent to child nodes
    #---------------------------------------------------------

# It seemed cleaner to do this as a separate step rather than during tree
    # construction.  The children nodes have links up to the parent node which
    # created them.  Now make links in the opposite direction, so the parents
    # can find the children.  We store the range of children nodes ($nc_beg,
    # $nc_end) of each parent with two additional indexes in the original array.
    # These will be undef if no children.
    foreach my $depth ( reverse( 1 .. $MAX_DEPTH ) ) {
        next unless defined( $match_tree[$depth] );
        my $nc_max = @{ $match_tree[$depth] } - 1;
        my $np_now;
        foreach my $nc ( 0 .. $nc_max ) {
            my $np = $match_tree[$depth]->[$nc]->[2];
            if ( !defined($np) ) {

# shouldn't happen
                #print STDERR "lost child $np at depth $depth\n";
                next;
            }
            if ( !defined($np_now) || $np != $np_now ) {
                $np_now = $np;
                $match_tree[ $depth - 1 ]->[$np]->[5] = $nc;
            }
            $match_tree[ $depth - 1 ]->[$np]->[6] = $nc;
        }
    } ## end loop to make links down to the child nodes

EXPLAIN_PRUNE > 0 && do {
        print "Tree complete. Found these groups:\n";
        foreach my $depth ( 0 .. $MAX_DEPTH ) {
            Dump_tree_groups( \@{ $match_tree[$depth] }, "depth=$depth" );
        }
    };

#------------------------------------------------------
    # Prune Tree Step 4. Make a list of nodes to be deleted
    #------------------------------------------------------

#  list of lines with tokens to be deleted:
    #  [$jbeg, $jend, $level_keep]
    #  $jbeg..$jend is the range of line indexes,
    #  $level_keep is the minimum level to keep
    my @delete_list;

# We work with a list of nodes to visit at the next deeper depth.
    my @todo_list;
    if ( defined( $match_tree[0] ) ) {
        @todo_list = ( 0 .. @{ $match_tree[0] } - 1 );
    }

foreach my $depth ( 0 .. $MAX_DEPTH ) {
        last if ( !@todo_list );
        my @todo_next;
        foreach my $np (@todo_list) {
            my ( $jbeg_p, $jend_p, $np_p, $lev_p, $pat_p, $nc_beg_p, $nc_end_p,
                $rindexes_p )
              = @{ $match_tree[$depth]->[$np] };
            my $nlines_p = $jend_p - $jbeg_p + 1;

# nothing to do if no children
            next unless defined($nc_beg_p);

# Define the number of lines to either keep or delete a child node.
            # This is the key decision we have to make.  We want to delete
            # short runs of matched lines, and keep long runs.  It seems easier
            # for the eye to follow breaks in monotonic level changes than
            # non-monotonic level changes.  For example, the following looks
            # best if we delete the lower level alignments:

#  [1]                  ~~ [];
            #  [ ["foo"], ["bar"] ] ~~ [ qr/o/, qr/a/ ];
            #  [ qr/o/, qr/a/ ]     ~~ [ ["foo"], ["bar"] ];
            #  [ "foo", "bar" ]     ~~ [ qr/o/, qr/a/ ];
            #  [ qr/o/, qr/a/ ]     ~~ [ "foo", "bar" ];
            #  $deep1               ~~ $deep1;

# So we will use two thresholds.
            my $nmin_mono     = $depth + 2;
            my $nmin_non_mono = $depth + 6;
            if ( $nmin_mono > $nlines_p - 1 ) {
                $nmin_mono = $nlines_p - 1;
            }
            if ( $nmin_non_mono > $nlines_p - 1 ) {
                $nmin_non_mono = $nlines_p - 1;
            }

# loop to keep or delete each child node
            foreach my $nc ( $nc_beg_p .. $nc_end_p ) {
                my ( $jbeg_c, $jend_c, $np_c, $lev_c, $pat_c, $nc_beg_c,
                    $nc_end_c )
                  = @{ $match_tree[ $depth + 1 ]->[$nc] };
                my $nlines_c     = $jend_c - $jbeg_c + 1;
                my $is_monotonic = $rline_values->[$jbeg_c]->[5];
                my $nmin         = $is_monotonic ? $nmin_mono : $nmin_non_mono;
                if ( $nlines_c < $nmin ) {
##print "deleting child, nlines=$nlines_c, nmin=$nmin\n";
                    push @delete_list, [ $jbeg_c, $jend_c, $lev_p ];
                }
                else {
##print "keeping child, nlines=$nlines_c, nmin=$nmin\n";
                    push @todo_next, $nc;
                }
            }
        }
        @todo_list = @todo_next;
    } ## end loop to mark nodes to delete

#------------------------------------------------------------
    # Prune Tree Step 5. Loop to delete selected alignment tokens
    #------------------------------------------------------------
    foreach my $item (@delete_list) {
        my ( $jbeg, $jend, $level_keep ) = @{$item};
        foreach my $jj ( $jbeg .. $jend ) {
            my $line = $rlines->[$jj];
            my @idel;
            my $rtokens = $line->{'rtokens'};
            my $imax    = @{$rtokens} - 2;
            foreach my $i ( 0 .. $imax ) {
                my $tok = $rtokens->[$i];
                my ( $raw_tok, $lev, $tag, $tok_count ) =
                  decode_alignment_token($tok);
                if ( $lev > $level_keep ) {
                    push @idel, $i;
                }
            }
            if (@idel) {
                delete_selected_tokens( $line, \@idel );
            }
        }
    } ## end loop to delete selected alignment tokens

return;
} ## end sub prune_alignment_tree

sub Dump_tree_groups {
    my ( $rgroup, $msg ) = @_;

# Debug routine
    print "$msg\n";
    local $LIST_SEPARATOR = ')(';
    foreach my $item ( @{$rgroup} ) {
        my @fix = @{$item};
        foreach my $val (@fix) { $val = "undef" unless defined($val); }
        $fix[4] = "...";
        print "(@fix)\n";
    }
    return;
} ## end sub Dump_tree_groups

{    ## closure for sub is_marginal_match

my %is_if_or;
    my %is_assignment;
    my %is_good_alignment;

# This test did not give sufficiently better results to use as an update,
    # but the flag is worth keeping as a starting point for future testing.
    use constant TEST_MARGINAL_EQ_ALIGNMENT => 0;

BEGIN {

my @q = qw(
          if unless or ||
        );
        @is_if_or{@q} = (1) x scalar(@q);

@q = qw(
          = **= += *= &= <<= &&=
          -= /= |= >>= ||= //=
          .= %= ^=
          x=
        );
        @is_assignment{@q} = (1) x scalar(@q);

# Vertically aligning on certain "good" tokens is usually okay
        # so we can be less restrictive in marginal cases.
        @q = qw( { ? => = );
        push @q, (',');
        @is_good_alignment{@q} = (1) x scalar(@q);
    } ## end BEGIN

sub is_marginal_match {

my ( $line_0, $line_1, $group_level, $imax_align, $imax_prev ) = @_;

# Decide if we should undo some or all of the common alignments of a
        # group of just two lines.

# Given:
        #   $line_0 and $line_1 - the two lines
        #   $group_level = the indentation level of the group being processed
        #   $imax_align = the maximum index of the common alignment tokens
        #                 of the two lines
        #   $imax_prev  = the maximum index of the common alignment tokens
        #                 with the line before $line_0 (=-1 of does not exist)

# Return:
        #   $is_marginal = true if the two lines should NOT be fully aligned
        #                = false if the two lines can remain fully aligned
        #   $imax_align  = the index of the highest alignment token shared by
        #                  these two lines to keep if the match is marginal.

# When we have an alignment group of just two lines like this, we are
        # working in the twilight zone of what looks good and what looks bad.
        # This routine is a collection of rules which work have been found to
        # work fairly well, but it will need to be updated from time to time.

my $is_marginal = 0;

#---------------------------------------
        # Always align certain special cases ...
        #---------------------------------------
        if (

# always keep alignments of a terminal else or ternary
            defined( $line_1->{'j_terminal_match'} )

# always align lists
            || $line_0->{'list_type'}

# always align hanging side comments
            || $line_1->{'is_hanging_side_comment'}

)
        {
            return ( $is_marginal, $imax_align );
        }

my $jmax_0           = $line_0->{'jmax'};
        my $jmax_1           = $line_1->{'jmax'};
        my $rtokens_1        = $line_1->{'rtokens'};
        my $rtokens_0        = $line_0->{'rtokens'};
        my $rfield_lengths_0 = $line_0->{'rfield_lengths'};
        my $rfield_lengths_1 = $line_1->{'rfield_lengths'};
        my $rpatterns_0      = $line_0->{'rpatterns'};
        my $rpatterns_1      = $line_1->{'rpatterns'};
        my $imax_next        = $line_1->{'imax_pair'};

# We will scan the alignment tokens and set a flag '$is_marginal' if
        # it seems that the an alignment would look bad.
        my $max_pad            = 0;
        my $saw_good_alignment = 0;
        my $saw_if_or;                # if we saw an 'if' or 'or' at group level
        my $raw_tokb = EMPTY_STRING;  # first token seen at group level
        my $jfirst_bad;
        my $line_ending_fat_comma;    # is last token just a '=>' ?
        my $j0_eq_pad;
        my $j0_max_pad = 0;

foreach my $j ( 0 .. $jmax_1 - 2 ) {
            my ( $raw_tok, $lev, $tag, $tok_count ) =
              decode_alignment_token( $rtokens_1->[$j] );
            if ( $raw_tok && $lev == $group_level ) {
                if ( !$raw_tokb ) { $raw_tokb = $raw_tok }
                $saw_if_or ||= $is_if_or{$raw_tok};
            }

# When the first of the two lines ends in a bare '=>' this will
            # probably be marginal match.  (For a bare =>, the next field length
            # will be 2 or 3, depending on side comment)
            $line_ending_fat_comma =
                 $j == $jmax_1 - 2
              && $raw_tok eq '=>'
              && $rfield_lengths_0->[ $j + 1 ] <= 3;

my $pad = $rfield_lengths_1->[$j] - $rfield_lengths_0->[$j];
            if ( $j == 0 ) {
                $pad += $line_1->{'leading_space_count'} -
                  $line_0->{'leading_space_count'};

# Remember the pad at a leading equals
                if ( $raw_tok eq '=' && $lev == $group_level ) {
                    $j0_eq_pad = $pad;
                    $j0_max_pad =
                      0.5 * ( $rfield_lengths_1->[0] + $rfield_lengths_0->[0] );
                    $j0_max_pad = 4 if ( $j0_max_pad < 4 );
                }
            }

if ( $pad < 0 )        { $pad     = -$pad }
            if ( $pad > $max_pad ) { $max_pad = $pad }
            if ( $is_good_alignment{$raw_tok} && !$line_ending_fat_comma ) {
                $saw_good_alignment = 1;
            }
            else {
                $jfirst_bad = $j unless defined($jfirst_bad);
            }
            my $pat_0 = $rpatterns_0->[$j];
            my $pat_1 = $rpatterns_1->[$j];
            if ( $pat_0 ne $pat_1 && length($pat_0) eq length($pat_1) ) {
                $pat_0 =~ tr/n/Q/;
                $pat_1 =~ tr/n/Q/;
            }
            if ( $pat_0 ne $pat_1 ) {

# Flag this as a marginal match since patterns differ.
                # Normally, we will not allow just two lines to match if
                # marginal. But we can allow matching in some specific cases.

$jfirst_bad  = $j if ( !defined($jfirst_bad) );
                $is_marginal = 1  if ( $is_marginal == 0 );
                if ( $raw_tok eq '=' ) {

# Here is an example of a marginal match:
                    #       $done{$$op} = 1;
                    #       $op         = compile_bblock($op);
                    # The left tokens are both identifiers, but
                    # one accesses a hash and the other doesn't.
                    # We'll let this be a tentative match and undo
                    # it later if we don't find more than 2 lines
                    # in the group.
                    $is_marginal = 2;
                }
            }
        }

$is_marginal = 1 if ( $is_marginal == 0 && $line_ending_fat_comma );

# Turn off the "marginal match" flag in some cases...
        # A "marginal match" occurs when the alignment tokens agree
        # but there are differences in the other tokens (patterns).
        # If we leave the marginal match flag set, then the rule is that we
        # will align only if there are more than two lines in the group.
        # We will turn of the flag if we almost have a match
        # and either we have seen a good alignment token or we
        # just need a small pad (2 spaces) to fit.  These rules are
        # the result of experimentation.  Tokens which misaligned by just
        # one or two characters are annoying.  On the other hand,
        # large gaps to less important alignment tokens are also annoying.
        if ( $is_marginal == 1
            && ( $saw_good_alignment || $max_pad < 3 ) )
        {
            $is_marginal = 0;
        }

# We will use the line endings to help decide on alignments...
        # See if the lines end with semicolons...
        my $sc_term0;
        my $sc_term1;
        if ( $jmax_0 < 1 || $jmax_1 < 1 ) {

# shouldn't happen
        }
        else {
            my $pat0 = $rpatterns_0->[ $jmax_0 - 1 ];
            my $pat1 = $rpatterns_1->[ $jmax_1 - 1 ];
            $sc_term0 = $pat0 =~ /;b?$/;
            $sc_term1 = $pat1 =~ /;b?$/;
        }

if ( !$is_marginal && !$sc_term0 ) {

# First line of assignment should be semicolon terminated.
            # For example, do not align here:
            #  $$href{-NUM_TEXT_FILES} = $$href{-NUM_BINARY_FILES} =
            #    $$href{-NUM_DIRS} = 0;
            if ( $is_assignment{$raw_tokb} ) {
                $is_marginal = 1;
            }
        }

# Try to avoid some undesirable alignments of opening tokens
        # for example, the space between grep and { here:
        #  return map { ( $_ => $_ ) }
        #    grep     { /$handles/ } $self->_get_delegate_method_list;
        $is_marginal ||=
             ( $raw_tokb eq '(' || $raw_tokb eq '{' )
          && $jmax_1 == 2
          && $sc_term0 ne $sc_term1;

#---------------------------------------
        # return if this is not a marginal match
        #---------------------------------------
        if ( !$is_marginal ) {
            return ( $is_marginal, $imax_align );
        }

# Undo the marginal match flag in certain cases,

# Two lines with a leading equals-like operator are allowed to
        # align if the patterns to the left of the equals are the same.
        # For example the following two lines are a marginal match but have
        # the same left side patterns, so we will align the equals.
        #     my $orig = my $format = "^<<<<< ~~\n";
        #     my $abc  = "abc";
        # But these have a different left pattern so they will not be
        # aligned
        #     $xmldoc .= $`;
        #     $self->{'leftovers'} .= "<bx-seq:seq" . $';

# First line semicolon terminated but second not, usually ok:
        #               my $want = "'ab', 'a', 'b'";
        #               my $got  = join( ", ",
        #                    map { defined($_) ? "'$_'" : "undef" }
        #                          @got );
        #  First line not semicolon terminated, Not OK to match:
        #   $$href{-NUM_TEXT_FILES} = $$href{-NUM_BINARY_FILES} =
        #      $$href{-NUM_DIRS} = 0;
        my $pat0 = $rpatterns_0->[0];
        my $pat1 = $rpatterns_1->[0];

#---------------------------------------------------------
        # Turn off the marginal flag for some types of assignments
        #---------------------------------------------------------
        if ( $is_assignment{$raw_tokb} ) {

# undo marginal flag if first line is semicolon terminated
            # and leading patters match
            if ($sc_term0) {    # && $sc_term1) {
                $is_marginal = $pat0 ne $pat1;
            }
        }
        elsif ( $raw_tokb eq '=>' ) {

# undo marginal flag if patterns match
            $is_marginal = $pat0 ne $pat1 || $line_ending_fat_comma;
        }
        elsif ( $raw_tokb eq '=~' ) {

# undo marginal flag if both lines are semicolon terminated
            # and leading patters match
            if ( $sc_term1 && $sc_term0 ) {
                $is_marginal = $pat0 ne $pat1;
            }
        }
        else {
            ##ok: (none of the above)
        }

#-----------------------------------------------------
        # Turn off the marginal flag if we saw an 'if' or 'or'
        #-----------------------------------------------------

# A trailing 'if' and 'or' often gives a good alignment
        # For example, we can align these:
        #  return -1     if $_[0] =~ m/^CHAPT|APPENDIX/;
        #  return $1 + 0 if $_[0] =~ m/^SECT(\d*)$/;

# or
        #  $d_in_m[2] = 29          if ( &Date_LeapYear($y) );
        #  $d         = $d_in_m[$m] if ( $d > $d_in_m[$m] );

if ($saw_if_or) {

# undo marginal flag if both lines are semicolon terminated
            if ( $sc_term0 && $sc_term1 ) {
                $is_marginal = 0;
            }
        }

# For a marginal match, only keep matches before the first 'bad' match
        if (   $is_marginal
            && defined($jfirst_bad)
            && $imax_align > $jfirst_bad - 1 )
        {
            $imax_align = $jfirst_bad - 1;
        }

#----------------------------------------------------------
        # Allow sweep to match lines with leading '=' in some cases
        #----------------------------------------------------------
        if ( $imax_align < 0 && defined($j0_eq_pad) ) {

if (

# If there is a following line with leading equals, or
                # preceding line with leading equals, then let the sweep align
                # them without restriction.  For example, the first two lines
                # here are a marginal match, but they are followed by a line
                # with leading equals, so the sweep-lr logic can align all of
                # the lines:

#  $date[1] = $month_to_num{ $date[1] };            # <--line_0
                #  @xdate   = split( /[:\/\s]/, $log->field('t') ); # <--line_1
                #  $day     = sprintf( "%04d/%02d/%02d", @date[ 2, 1, 0 ] );
                #  $time    = sprintf( "%02d:%02d:%02d", @date[ 3 .. 5 ] );

# Likewise, if we reverse the two pairs we want the same result

#  $day     = sprintf( "%04d/%02d/%02d", @date[ 2, 1, 0 ] );
                #  $time    = sprintf( "%02d:%02d:%02d", @date[ 3 .. 5 ] );
                #  $date[1] = $month_to_num{ $date[1] };            # <--line_0
                #  @xdate   = split( /[:\/\s]/, $log->field('t') ); # <--line_1

(
                       $imax_next >= 0
                    || $imax_prev >= 0
                    || TEST_MARGINAL_EQ_ALIGNMENT
                )
                && $j0_eq_pad >= -$j0_max_pad
                && $j0_eq_pad <= $j0_max_pad
              )
            {

# But do not do this if there is a comma before the '='.
                # For example, the first two lines below have commas and
                # therefore are not allowed to align with lines 3 & 4:

# my ( $x, $y ) = $self->Size();                      #<--line_0
                # my ( $left, $top, $right, $bottom ) = $self->Window(); #<--l_1
                # my $vx = $right - $left;
                # my $vy = $bottom - $top;

if ( $rpatterns_0->[0] !~ /,/ && $rpatterns_1->[0] !~ /,/ ) {
                    $imax_align = 0;
                }
            }
        }

return ( $is_marginal, $imax_align );
    } ## end sub is_marginal_match
} ## end closure for sub is_marginal_match

sub get_extra_leading_spaces {

my ( $rlines, $rgroups ) = @_;

#----------------------------------------------------------
    # Define any extra indentation space (for the -lp option).
    # Here is why:
    # If a list has side comments, sub scan_list must dump the
    # list before it sees everything.  When this happens, it sets
    # the indentation to the standard scheme, but notes how
    # many spaces it would have liked to use.  We may be able
    # to recover that space here in the event that all of the
    # lines of a list are back together again.
    #----------------------------------------------------------

return 0 if ( !@{$rlines} || !@{$rgroups} );

my $object = $rlines->[0]->{'indentation'};
    return 0 if ( !ref($object) );
    my $extra_leading_spaces            = 0;
    my $extra_indentation_spaces_wanted = get_recoverable_spaces($object);
    return ($extra_leading_spaces) if ( !$extra_indentation_spaces_wanted );

my $min_spaces = $extra_indentation_spaces_wanted;
    if ( $min_spaces > 0 ) { $min_spaces = 0 }

# loop over all groups
    my $ng      = -1;
    my $ngroups = @{$rgroups};
    foreach my $item ( @{$rgroups} ) {
        $ng++;
        my ( $jbeg, $jend ) = @{$item};
        foreach my $j ( $jbeg .. $jend ) {
            next if ( $j == 0 );

# all indentation objects must be the same
            if ( $object != $rlines->[$j]->{'indentation'} ) {
                return 0;
            }
        }

# find the maximum space without exceeding the line length for this group
        my $avail = $rlines->[$jbeg]->get_available_space_on_right();
        my $spaces =
          ( $avail > $extra_indentation_spaces_wanted )
          ? $extra_indentation_spaces_wanted
          : $avail;

#--------------------------------------------------------
        # Note: min spaces can be negative; for example with -gnu
        # f(
        #   do { 1; !!(my $x = bless []); }
        #  );
        #--------------------------------------------------------
        # The following rule is needed to match older formatting:
        # For multiple groups, we will keep spaces non-negative.
        # For a single group, we will allow a negative space.
        if ( $ngroups > 1 && $spaces < 0 ) { $spaces = 0 }

# update the minimum spacing
        if ( $ng == 0 || $spaces < $extra_leading_spaces ) {
            $extra_leading_spaces = $spaces;
        }
    }

# update the indentation object because with -icp the terminal
    # ');' will use the same adjustment.
    $object->permanently_decrease_available_spaces( -$extra_leading_spaces );
    return $extra_leading_spaces;
} ## end sub get_extra_leading_spaces

sub forget_side_comment {
    my ($self) = @_;
    $self->[_last_side_comment_column_] = 0;
    return;
}

sub is_good_side_comment_column {
    my ( $self, $line, $line_number, $level, $num5 ) = @_;

# Upon encountering the first side comment of a group, decide if
    # a previous side comment should be forgotten.  This involves
    # checking several rules.

# Return true to KEEP old comment location
    # Return false to FORGET old comment location
    my $KEEP   = 1;
    my $FORGET = 0;

my $rfields                 = $line->{'rfields'};
    my $is_hanging_side_comment = $line->{'is_hanging_side_comment'};

# RULE1: Never forget comment before a hanging side comment
    return $KEEP if ($is_hanging_side_comment);

# RULE2: Forget a side comment after a short line difference,
    # where 'short line difference' is computed from a formula.
    # Using a smooth formula helps minimize sudden large changes.
    my $line_diff = $line_number - $self->[_last_side_comment_line_number_];
    my $alev_diff = abs( $level - $self->[_last_side_comment_level_] );

# '$num5' is the number of comments in the first 5 lines after the first
    # comment.  It is needed to keep a compact group of side comments from
    # being influenced by a more distant side comment.
    $num5 = 1 if ( !$num5 );

# Some values:

#        $adiff  $num5   $short_diff
    #        0       *       12
    #        1       1       6
    #        1       2       4
    #        1       3       3
    #        1       4       2
    #        2       1       4
    #        2       2       2
    #        2       3       1
    #        3       1       3
    #        3       2       1

my $short_diff = SC_LONG_LINE_DIFF / ( 1 + $alev_diff * $num5 );

return $FORGET
      if ( $line_diff > $short_diff
        || !$rOpts_valign_side_comments );

# RULE3: Forget a side comment if this line is at lower level and
    # ends a block
    my $last_sc_level = $self->[_last_side_comment_level_];
    return $FORGET
      if ( $level < $last_sc_level
        && $is_closing_block_type{ substr( $rfields->[0], 0, 1 ) } );

# RULE 4: Forget the last side comment if this comment might join a cached
    # line ...
    if ( my $cached_line_type = get_cached_line_type() ) {

# ... otherwise side comment alignment will get messed up.
        # For example, in the following test script
        # with using 'perltidy -sct -act=2', the last comment would try to
        # align with the previous and then be in the wrong column when
        # the lines are combined:

# foreach $line (
        #    [0, 1, 2], [3, 4, 5], [6, 7, 8],    # rows
        #    [0, 3, 6], [1, 4, 7], [2, 5, 8],    # columns
        #    [0, 4, 8], [2, 4, 6]
        #  )                                     # diagonals
        return $FORGET
          if ( $cached_line_type == 2 || $cached_line_type == 4 );
    }

# Otherwise, keep it alive
    return $KEEP;
} ## end sub is_good_side_comment_column

sub align_side_comments {

my ( $self, $rlines, $rgroups ) = @_;

# Align any side comments in this batch of lines

# Given:
    #  $rlines  - the lines
    #  $rgroups - the partition of the lines into groups
    #
    # We will be working group-by-group because all side comments
    # (real or fake) in each group are already aligned. So we just have
    # to make alignments between groups wherever possible.

# An unusual aspect is that within each group we have aligned both real
    # and fake side comments.  This has the consequence that the lengths of
    # long lines without real side comments can cause 'push' all side comments
    # to the right.  This seems unusual, but testing with and without this
    # feature shows that it is usually better this way.  Otherwise, side
    # comments can be hidden between long lines without side comments and
    # thus be harder to read.

my $group_level        = $self->[_group_level_];
    my $continuing_sc_flow = $self->[_last_side_comment_length_] > 0
      && $group_level == $self->[_last_level_written_];

# Find groups with side comments, and remember the first nonblank comment
    my $j_sc_beg;
    my @todo;
    my $ng = -1;
    foreach my $item ( @{$rgroups} ) {
        $ng++;
        my ( $jbeg, $jend ) = @{$item};
        foreach my $j ( $jbeg .. $jend ) {
            my $line = $rlines->[$j];
            my $jmax = $line->{'jmax'};
            if ( $line->{'rfield_lengths'}->[$jmax] ) {

# this group has a line with a side comment
                push @todo, $ng;
                if ( !defined($j_sc_beg) ) {
                    $j_sc_beg = $j;
                }
                last;
            }
        }
    }

# done if no groups with side comments
    return unless @todo;

# Count $num5 = number of comments in the 5 lines after the first comment
    # This is an important factor in a decision formula
    my $num5 = 1;
    foreach my $jj ( $j_sc_beg + 1 .. @{$rlines} - 1 ) {
        my $ldiff = $jj - $j_sc_beg;
        last if ( $ldiff > 5 );
        my $line   = $rlines->[$jj];
        my $jmax   = $line->{'jmax'};
        my $sc_len = $line->{'rfield_lengths'}->[$jmax];
        next if ( !$sc_len );
        $num5++;
    }

# Forget the old side comment location if necessary
    my $line_0 = $rlines->[$j_sc_beg];
    my $lnum =
      $j_sc_beg + $self->[_file_writer_object_]->get_output_line_number();
    my $keep_it =
      $self->is_good_side_comment_column( $line_0, $lnum, $group_level, $num5 );
    my $last_side_comment_column =
      $keep_it ? $self->[_last_side_comment_column_] : 0;

# If there are multiple groups we will do two passes
    # so that we can find a common alignment for all groups.
    my $MAX_PASS = @todo > 1 ? 2 : 1;

# Loop over passes
    my $max_comment_column = $last_side_comment_column;
    foreach my $PASS ( 1 .. $MAX_PASS ) {

# If there are two passes, then on the last pass make the old column
        # equal to the largest of the group.  This will result in the comments
        # being aligned if possible.
        if ( $PASS == $MAX_PASS ) {
            $last_side_comment_column = $max_comment_column;
        }

# Loop over the groups with side comments
        my $column_limit;
        foreach my $ngr (@todo) {
            my ( $jbeg, $jend ) = @{ $rgroups->[$ngr] };

# Note that since all lines in a group have common alignments, we
            # just have to work on one of the lines (the first line).
            my $line                    = $rlines->[$jbeg];
            my $jmax                    = $line->{'jmax'};
            my $is_hanging_side_comment = $line->{'is_hanging_side_comment'};
            last
              if ( $PASS < $MAX_PASS && $is_hanging_side_comment );

# the maximum space without exceeding the line length:
            my $avail = $line->get_available_space_on_right();

# try to use the previous comment column
            my $side_comment_column = $line->get_column( $jmax - 1 );
            my $move = $last_side_comment_column - $side_comment_column;

# Remember the maximum possible column of the first line with
            # side comment
            if ( !defined($column_limit) ) {
                $column_limit = $side_comment_column + $avail;
            }

next if ( $jmax <= 0 );

# but if this doesn't work, give up and use the minimum space
            my $min_move = $rOpts_minimum_space_to_comment - 1;
            if ( $move > $avail ) {
                $move = $min_move;
            }

# but we want some minimum space to the comment
            if (   $move >= 0
                && $j_sc_beg == 0
                && $continuing_sc_flow )
            {
                $min_move = 0;
            }

# remove constraints on hanging side comments
            if ($is_hanging_side_comment) { $min_move = 0 }

if ( $move < $min_move ) {
                $move = $min_move;
            }

# don't exceed the available space
            if ( $move > $avail ) { $move = $avail }

# We can only increase space, never decrease.
            if ( $move < 0 ) { $move = 0 }

# Discover the largest column on the preliminary  pass
            if ( $PASS < $MAX_PASS ) {
                my $col = $line->get_column( $jmax - 1 ) + $move;

# but ignore columns too large for the starting line
                if ( $col > $max_comment_column && $col < $column_limit ) {
                    $max_comment_column = $col;
                }
            }

# Make the changes on the final pass
            else {
                $line->increase_field_width( $jmax - 1, $move );

# remember this column for the next group
                $last_side_comment_column = $line->get_column( $jmax - 1 );
            }
        } ## end loop over groups
    } ## end loop over passes

# Find the last side comment
    my $j_sc_last;
    my $ng_last = $todo[-1];
    my ( $jbeg, $jend ) = @{ $rgroups->[$ng_last] };
    foreach my $jj ( reverse( $jbeg .. $jend ) ) {
        my $line = $rlines->[$jj];
        my $jmax = $line->{'jmax'};
        if ( $line->{'rfield_lengths'}->[$jmax] ) {
            $j_sc_last = $jj;
            last;
        }
    }

# Save final side comment info for possible use by the next batch
    if ( defined($j_sc_last) ) {
        my $line_number =
          $self->[_file_writer_object_]->get_output_line_number() + $j_sc_last;
        $self->[_last_side_comment_column_]      = $last_side_comment_column;
        $self->[_last_side_comment_line_number_] = $line_number;
        $self->[_last_side_comment_level_]       = $group_level;
    }
    return;
} ## end sub align_side_comments

###########################################
# CODE SECTION 6: Pad Signed Number Columns
###########################################

use constant DEBUG_VSN => 0;

my %is_digit_char;
my %is_plus_or_minus;
my %is_leading_sign_pattern;
my %is_opening_token;

BEGIN {

# PATTERNS: A pattern is basically the concatenation of all token types in
    # the field, with keywords converted to their actual text.  The formatter
    # has changed things like 'print' to 'priNt' so that all 'n's are numbers.
    # The following patterns 'n' can match a signed number of interest.
    # Thus 'n'=a signed or unsigned number, 'b'=a space, '}'=one of ) ] }
    my @q = ( 'n,', 'n,b', 'nb', 'nb}', 'nb},', 'n},', 'n};' );

@is_leading_sign_pattern{@q} = (1) x scalar(@q);

@q = qw( 0 1 2 3 4 5 6 7 8 9 );
    @is_digit_char{@q} = (1) x scalar(@q);

@q = qw( + - );
    @is_plus_or_minus{@q} = (1) x scalar(@q);

@q = qw< { ( [ >;
    @is_opening_token{@q} = (1) x scalar(@q);
}

sub min_max_median {
    my ($rvalues) = @_;

# Given:  $rvalues = ref to an array of numbers
    # Return: the min, max, and median
    my $num = @{$rvalues};
    return unless ($num);

my @sorted = sort { $a <=> $b } @{$rvalues};

my $min  = $sorted[0];
    my $max  = $sorted[-1];
    my $imid = int $num / 2;
    my $median =
        @sorted % 2
      ? $sorted[$imid]
      : ( $sorted[ $imid - 1 ] + $sorted[$imid] ) / 2;

return ( $min, $max, $median );
} ## end sub min_max_median

sub end_signed_number_column {
    my ( $rgroup_lines, $rcol_hash, $ix_last ) = @_;

# Finish formatting a column of unsigned numbers
    # Given:
    #   $rgroup_lines - the current vertical aligment group of lines
    #   $rcol_hash    - a hash of information about this vertical column
    #   $ix_last      - index of the last line of this vertical column
    # Task:
    #   If this is a mixture of signed and unsigned numbers, then add a
    #   single space before the unsigned numbers to improve appearance.
    return unless ($rcol_hash);
    my $jcol          = $rcol_hash->{jcol};
    my $unsigned      = $rcol_hash->{unsigned_count};
    my $signed        = $rcol_hash->{signed_count};
    my $rsigned_lines = $rcol_hash->{rsigned_lines};

if ( !$signed && $unsigned ) {
        DEVEL_MODE
          && Fault("avoid calling without mixed signed and unsigned\n");
        return;
    }

my $pos_start_number = $rcol_hash->{pos_start_number};
    my $char_end_part1   = $rcol_hash->{char_end_part1};
    my $ix_first         = $rcol_hash->{ix_first};
    my $nlines           = $ix_last - $ix_first + 1;

# check for skipped lines, shouldn't happen
    if ( $signed + $unsigned != $nlines ) {
        my $line    = $rgroup_lines->[$ix_last];
        my $rfields = $line->{'rfields'};
        my $text    = join EMPTY_STRING, @{$rfields};
        DEVEL_MODE && Fault(<<EOM);
We seem to have miscounted lines, please check:
signed=$signed
j=$jcol
unsigned=$unsigned
ix_first=$ix_first
ix_last=$ix_last
nlines=$nlines
text=$text
EOM
        return;
    }

#-----------------------------------------------------------------
    # Form groups of unsigned numbers from the list of signed numbers.
    #-----------------------------------------------------------------
    my @unsigned_subgroups;
    my $ix_last_negative = $ix_first - 1;
    my %is_signed;
    foreach my $ix ( @{$rsigned_lines} ) {
        $is_signed{$ix} = 1;
        my $Nu = $ix - $ix_last_negative - 1;
        if ( $Nu > 0 && $Nu <= $rOpts_valign_signed_numbers_limit ) {
            push @unsigned_subgroups, [ $ix_last_negative + 1, $ix - 1 ];
        }
        $ix_last_negative = $ix;
    }

# Exclude groups with more than about 20 consecutive numbers.  Little
    # visual improvement is gained by padding more than this, and this avoids
    # large numbers of differences in a file when a single line is changed.
    my $Nu = $ix_last - $ix_last_negative;
    if ( $Nu > 0 && $Nu <= $rOpts_valign_signed_numbers_limit ) {
        push @unsigned_subgroups, [ $ix_last_negative + 1, $ix_last ];
    }

if ( !@unsigned_subgroups ) { return }    # shouldn't happen

#--------------------------------------------
    # Find number lengths for irregularity checks
    #--------------------------------------------
    # Padding signed numbers looks best when the numbers, excluding signs,
    # all have about the same length. When the lengths are irregular, with
    # mostly longer unsigned numbers, it doesn't look good to do this. So
    # we need to filter out these bad-looking cases.

# The 'field_lengths' are unreliable because they may include some
    # arbitrary trailing text; see 'substr.t' So we must look for the end of
    # the number at a space, comma, or closing container token. Note that these
    # lengths include the length of any signs.
    my @len_unsigned;
    my @len_signed;
    my @lengths;
    foreach my $ix ( $ix_first .. $ix_last ) {
        my $line   = $rgroup_lines->[$ix];
        my $rfield = $line->{'rfields'};
        my $str    = substr( $rfield->[$jcol], $pos_start_number );
        if ( $str =~ /^([^\s\,\)\]\}]*)/ ) { $str = $1 }
        my $len = length($str);
        if   ( $is_signed{$ix} ) { push @len_signed,   $len }
        else                     { push @len_unsigned, $len }
        push @lengths, [ $len, $ix ];
    }

my ( $min_unsigned_length, $max_unsigned_length, $median_unsigned_length )
      = min_max_median( \@len_unsigned );
    my ( $min_signed_length, $max_signed_length, $median_signed_length ) =
      min_max_median( \@len_signed );

# Skip padding if no signed numbers exceed unsigned numbers in length
    if ( $max_signed_length <= $min_unsigned_length ) {
        return;
    }

# If max signed length is greatest - all unsigned values can be padded
    elsif ( $max_signed_length > $max_unsigned_length ) {

# Example:
        #    %wind_dir = (
        #        'n'  => [  1,  0 ],
        #        'ne' => [  1,  1 ],
        #        'e'  => [  0,  1 ],
        #        'se' => [ -1,  1 ],
        #        's'  => [ -1,  0 ],
        #        'sw' => [ -1, -1 ],
        #        'w'  => [  0, -1 ],
        #        'nw' => [  1, -1 ],
        #        ''   => [  0,  0 ],
        #    );

# This is the ideal case - ok to continue and pad
    }

# intermediate case: some signed numbers cannot be padded ...
    else {

# We have to take a closer look.
        # Here is an example which looks bad if we do padding like this:
        #    my %hash = (
        #        X0 => -12867.098241163,
        #        X1 =>  2.31694338671684,       # unsigned w/   excess>0
        #        X2 => 0.0597726714860419,      # max length => excess=0
        #        Y0 =>  30043.1335503155,       # unsigned w/   excess>0
        #        Y1 => 0.0525784981597044,      # max length => excess=0
        #        Y2 => -2.32447131600783,
        #    );

# To decide what looks okay, we count 'good' and 'bad' line interfaces:
        #    X0 - X1 = good (X0 is signed and X1 can move)
        #    X1 - X2 = bad  (x1 can move but x2 cannot)
        #    X2 - Y0 = bad  (x2 cannot move but Y0 can move)
        #    Y0 - Y1 = bad  (Y0 can move but Y1 cannot move)
        #    Y1 - Y2 = bad  (Y1 cannot move and Y2 is signed)
        # Result: 4 bad interfaces and 1 good => so we will skip this
        my $good_count = 0;
        my $bad_count  = 0;
        foreach my $item (@lengths) {
            $item->[0] = $max_unsigned_length - $item->[0];
        }
        my $item0 = shift @lengths;
        my ( $excess, $ix ) = @{$item0};
        my $immobile_count = $excess ? 0 : 1;
        foreach my $item (@lengths) {
            my $excess_m = $excess;
            my $ix_m     = $ix;
            ( $excess, $ix ) = @{$item};
            if ( !$excess ) { $immobile_count++ }

if ( $is_signed{$ix_m} ) {

# signed-unsigned interface
                if ( !$is_signed{$ix} ) {
                    if   ($excess) { $good_count++ }
                    else           { $bad_count++ }
                }

# signed-signed: ok, not good or bad
            }
            else {

# unsigned-signed interface
                if ( $is_signed{$ix} ) {
                    if   ($excess_m) { $good_count++ }
                    else             { $bad_count++ }
                }

# unsigned-unsigned: bad if different
                else {
                    if ( $excess_m xor $excess ) {
                        $bad_count++;
                    }
                }
            }
        }

# Filter 1: skip if more interfaces are 'bad' than 'good'
        if ( $bad_count > $good_count ) {
            return;
        }

# Filter 2: skip in a table with multiple 'bad' interfaces and where
        # 'most' of the unsigned lengths are shorter than the signed lengths.
        # Using the median value makes this insensitive to small changes.
        if (   $median_unsigned_length >= $median_signed_length
            && $bad_count > 1
            && $immobile_count > 1 )
        {
            return;
        }

# Anything that gets past these filters should look ok if padded
    }

#---------------------------------------------
    # Compute actual available space for each line
    #---------------------------------------------
    my %excess_space;
    my $movable_count = 0;
    foreach my $item (@unsigned_subgroups) {
        my ( $ix_min, $ix_max ) = @{$item};
        foreach my $ix ( $ix_min .. $ix_max ) {
            my $line                = $rgroup_lines->[$ix];
            my $leading_space_count = $line->{'leading_space_count'};
            my $jmax                = $line->{'jmax'};
            my $rfield_lengths      = $line->{'rfield_lengths'};
            if ( $jcol >= $jmax ) {

# shouldn't happen
                DEVEL_MODE && Fault("jcol=$jcol >= jmax=$jmax\n");
                return;
            }
            my @alignments = @{ $line->{'ralignments'} };
            my $col        = $alignments[$jcol]->{'column'};
            my $col_start =
                $jcol == 0
              ? $leading_space_count
              : $alignments[ $jcol - 1 ]->{'column'};
            my $avail        = $col - $col_start;
            my $field_length = $rfield_lengths->[$jcol];
            my $excess       = $avail - $field_length;
            $excess_space{$ix} = $excess;
            if ( $excess > 0 ) { $movable_count++ }
        }
    }

return unless ($movable_count);

# Count the number of signed-unsigned interfaces that would change
    # if we do the padding
    my $Nc = 0;
    foreach my $item (@unsigned_subgroups) {
        my ( $ix_min, $ix_max ) = @{$item};
        $Nc++ if ( $excess_space{$ix_min} > 0 && $ix_min != $ix_first );
        $Nc++ if ( $excess_space{$ix_max} > 0 && $ix_max != $ix_last );
    }

#--------------------------------------------------------------------
    # Sparsity check:
    # Give up if the number of interface changes will be below the cutoff
    #--------------------------------------------------------------------
    if ( $unsigned > $Nc * $rOpts_valign_signed_numbers_limit ) {
        return;
    }

#------------------------------------------------------------------------
    # Insert an extra space before the unsigned numbers if space is available
    #------------------------------------------------------------------------
    foreach my $item (@unsigned_subgroups) {
        my ( $ix_min, $ix_max ) = @{$item};

foreach my $ix ( $ix_min .. $ix_max ) {
            next if ( $excess_space{$ix} <= 0 );
            my $line           = $rgroup_lines->[$ix];
            my $rfields        = $line->{'rfields'};
            my $rfield_lengths = $line->{'rfield_lengths'};
            pad_signed_field(
                \$rfields->[$jcol], \$rfield_lengths->[$jcol],
                $pos_start_number,  $char_end_part1
            );
        }
    }
    return;
} ## end sub end_signed_number_column

sub pad_signed_field {
    my ( $rstr, $rstr_len, $pos_start_number, $char_end_part1 ) = @_;

# Insert an extra space before a number to highlight algebraic signs
    # in a column of numbers.
    # Given:
    #  $rstr     = ref to string
    #  $rstr_len = ref to display width of string (could include wide chars)
    #  $pos_start_number = string position of the leading digit
    #  $char_end_part1 = character at $pos_start_number - 1
    # Task: update $rstr and $rstr_len with a single space

# First partition the string into $part1 and $part2, so that the
    # number starts at the beginning of part2.
    my $part1 = EMPTY_STRING;
    my $part2 = ${$rstr};
    my $str   = ${$rstr};
    if ( $pos_start_number > 0 ) {
        my $len = length($str);
        if ( $pos_start_number >= $len ) {
            DEVEL_MODE && Fault(<<EOM);
Expection position '$pos_start_number' < length $len of string '$str'
EOM
            return;
        }
        $part1 = substr( $str, 0, $pos_start_number );
        $part2 = substr( $str, $pos_start_number );

# VERIFY that we are inserting a new space after either
        #   (1) an existing space or
        #   (2) an opening token.
        # Otherwise disaster can occur. An error here implies a programming
        # error in defining '$pos_start_number'.

my $test_char1 = substr( $part1, -1, 1 );
        if ( $test_char1 ne $char_end_part1 ) {
            DEVEL_MODE && Fault(<<EOM);
Expecting '$char_end_part1' but saw '$test_char1' in string '$str'
Probably bad position '$pos_start_number'
EOM
            return;
        }
    }

# VERIFY we are inserting a space before a digit character
    my $test_char2 = substr( $part2, 0, 1 );
    if ( $is_digit_char{$test_char2} ) {
        ${$rstr} = $part1 . SPACE . $part2;
        ${$rstr_len} += 1;
    }
    else {
        DEVEL_MODE && Fault(<<EOM);
Expecting test char2 as leading digit but saw '$test_char2' in string '$str'
May be bad position '$pos_start_number'
EOM
    }
    return;
} ## end sub pad_signed_field

sub split_field {
    my ( $pat1, $field, $pattern ) = @_;

# Given;
    #   $pat1    = first part of a pattern before a numeric type 'n'
    #   $field   = corresponding text field
    #   $pattern = full pattern
    # Return:
    #   $pos_start_number = positiion in $field where the number should start
    #                     = 0 if cannot find
    #   $char_end_part1 = the character preceding $pos_start_number
    #   $ch_opening     = the preceding opening container character, if any

# We have to find where the possible number starts in this field.
    # The safe thing to do is return @fail if anything does not look right.

my $pos_start_number = 0;
    my $char_end_part1   = EMPTY_STRING;
    my $ch_opening       = EMPTY_STRING;
    my @fail             = ( $pos_start_number, $char_end_part1, $ch_opening );

# Be sure there is just 'n' in the pattern. Multiple terms can occur
    # when fields are joined, but since we are jumping into the middle
    # of a field it is safest not to try to handle them.
    my $n_count = ( $pattern =~ tr/n/n/ );
    if ( $n_count && $n_count > 1 ) {
        return @fail;
    }

# Same thing for commas
    my $comma_count = ( $pattern =~ tr/,/,/ );
    if ( $comma_count && $comma_count > 1 ) {
        return @fail;
    }

# Require 0 or 1 braces
    my $len_field = length($field);
    my $len_pat1  = length($pat1);
    return @fail unless ( $len_pat1 && $len_field );

# Look at the pattern ending
    my $ending_b = 0;
    my $ch       = substr( $pat1, -1, 1 );
    if ( $ch eq 'b' ) {
        $ending_b       = 1;
        $ch             = substr( $pat1, -2, 1 );
        $char_end_part1 = SPACE;
    }

# handle either '{b' or '{'
    if ( $ch eq '{' ) {

# Only one brace
        my $brace_count = ( $pat1 =~ tr/\{/\{/ );
        return @fail if ( $brace_count != 1 );

my $i_paren   = index( $field, '(' );
        my $i_bracket = index( $field, '[' );
        my $i_brace   = index( $field, '{' );
        my $i_opening = length($field);
        if ( $i_paren >= 0 ) {
            $i_opening  = $i_paren;
            $ch_opening = '(';
        }
        if (   $i_bracket >= 0
            && $i_bracket < $i_opening )
        {
            $i_opening  = $i_bracket;
            $ch_opening = '[';
        }
        if ( $i_brace >= 0 && $i_brace < $i_opening ) {
            $i_opening  = $i_brace;
            $ch_opening = '{';
        }
        if (   $i_opening >= 0
            && $i_opening < length($field) - 1 )
        {
            $pos_start_number = $i_opening + 1 + $ending_b;
            $char_end_part1   = $ch_opening
              if ( !$ending_b );
        }
        else {
            # strange - could not find the opening token
        }
    }

# no braces: maybe '=>b'
    else {

# looking for patterns ending in '=b' or '=>b'
        if ( !$ending_b ) { return @fail }

# find the = in the text
        my $pos_equals = index( $field, '=' );
        return @fail if ( $pos_equals < 0 );

# be sure there are no other '=' in the pattern
        my $equals_count = ( $pat1 =~ tr/=/=/ );
        return @fail if ( $equals_count != 1 );

if ( $len_pat1 >= 2 && substr( $pat1, -2, 2 ) eq '=b' ) {
            $pos_start_number = $pos_equals + 2;
        }
        elsif ( $len_pat1 >= 3 && substr( $pat1, -3, 3 ) eq '=>b' ) {
            $pos_start_number = $pos_equals + 3;
        }
        else {

# cannot handle this pattern
            return @fail;
        }
    }

if ( $pos_start_number <= 0 || $pos_start_number >= $len_field ) {
        return @fail;
    }

return ( $pos_start_number, $char_end_part1, $ch_opening );
} ## end sub split_field

sub field_matches_end_pattern {
    my ( $field2, $pat2 ) = @_;

# Check that a possible numeric field matches the ending pattern

# Given:
    #  $field2 = the rest of the field after removing any sign
    #  $pat2   = the end pattern of this field
    # Return:
    #  false if field is definitely non-numeric
    #  true otherwise

my $next_char   = substr( $pat2, 1, 1 );
    my $field2_trim = EMPTY_STRING;

# if pattern is one of: 'n,', 'n,b'
    if ( $next_char eq ',' ) {
        my $icomma = index( $field2, ',' );
        if ( $icomma >= 0 ) {
            $field2_trim = substr( $field2, 0, $icomma );
        }
    }

# if pattern is one of: 'nb', 'nb}', 'nb},'
    elsif ( $next_char eq 'b' ) {
        my $ispace = index( $field2, SPACE );
        if ( $ispace >= 0 ) {
            $field2_trim = substr( $field2, 0, $ispace );
        }
    }

# if pattern is one of 'n},', 'n};'
    elsif ( $next_char eq '}' ) {
        if ( $field2 =~ /^([^\)\}\]]+)/ ) {
            $field2_trim = $1;
        }
    }

# unrecognized pattern
    else {
        DEVEL_MODE && Fault(<<EOM);
Unexpected ending pattern '$pat2' next='$next_char' field2='$field2'
The hash 'is_leading_sign_pattern' seems to have changed but the code
has not been updated to handle it. Please fix.
EOM
        return;
    }

if ( !length($field2_trim) ) {
        DEVEL_MODE
          && Fault(
            "STRANGE: cannot find end of field=$field2 for pat=$pat2 \n");
        return;
    }

# Reject obviously non-numeric fields just to be sure we did not
    # jump into a quote of some kind
    if ( $field2_trim !~ /^[\d\.\+\-abcdefpx_]+$/i ) {
        DEBUG_VSN
          && print {*STDERR}
"Rejecting match to pat2='$pat2' with next=$next_char field2=$field2 trimmed='$field2_trim'\n";
        return;
    }
    return 1;
} ## end sub field_matches_end_pattern

sub pad_signed_number_columns {
    my ($rgroup_lines) = @_;

# Given:
    #   $rgroup_lines = the current vertical alignment group of lines
    # Task:
    #   Look for columns of aligned numeric values, some of whose numbers
    #   have algebraic signs. Add a leading space to the unsigned
    #   numbers, if possible, so that the just the signs appear as the first
    #   character. Example of what we want to do:

#    my @correct = (
    #        [  123456.79,   86753090000.868,  11 ],
    #        [ -123456.79,  -86753090000.868, -11 ],
    #        [  123456.001,  80.080,           10 ],
    #        [ -123456.001, -80.080,           0 ],
    #        [  10.9,        10.9,             11 ],
    #    );

# The logic here is complex because we are working with bits of text
    # which have been broken into patterns which are convenient for the
    # vertical aligner, but we no longer have the original tokenization
    # which would have indicated the precise bounds of numbers.  So we
    # have to procede very carefully with lots of checks. There are
    # more checks than really necessary now because originally numbers
    # and quotes were both indicated with pattern 'Q'. But now numbers are
    # uniquely marked as pattern 'n', so there is less risk of an error.
    # The extra checks take very little time so they are retained.

return unless ($rOpts_valign_signed_numbers);

my %column_info;
    my @columns;

#----------------
    # loop over lines
    #----------------
    my $ix_line = -1;
    my $jmax    = -1;
    foreach my $line ( @{$rgroup_lines} ) {
        $ix_line++;
        my $jmax_last = $jmax;
        $jmax = $line->{'jmax'};
        my $jmax_change = $jmax ne $jmax_last;

my @alignments = @{ $line->{'ralignments'} };
        my $rfields    = $line->{'rfields'};
        my $rpatterns  = $line->{'rpatterns'};
        my $rtokens    = $line->{'rtokens'};

#-----------------------------------------------
        # Check for a reduction in the number of columns
        #-----------------------------------------------
        if ( $jmax < $jmax_last ) {

foreach my $jcol ( keys %column_info ) {

# end any stranded columns on the right
                next if ( $jcol < $jmax );
                my $rcol_hash = $column_info{$jcol};
                next unless ($rcol_hash);
                if (   $rcol_hash->{signed_count}
                    && $rcol_hash->{unsigned_count} )
                {
                    end_signed_number_column( $rgroup_lines, $rcol_hash,
                        $ix_line - 1 );
                }
                delete $column_info{$jcol};
            }

# Try to keep the end data column running; test case 'rfc.in'
            # The last item in a list will still need a trailing comma.
            my $jcol = $jmax - 1;
            if ( $jcol >= 0 && $column_info{$jcol} ) {
                my $alignment = $alignments[$jcol];
                my $old_col   = $columns[$jcol];
                my $col       = $alignment->{column};

# only do this if the text has a leading digit
                if (   $col < $old_col
                    && $rfields->[$jcol] =~ /^[+-]?\d/ )
                {
                    my $spaces_needed = $old_col - $col;
                    my $spaces_available =
                      $line->get_available_space_on_right();
                    if ( $spaces_available >= $spaces_needed ) {
                        $line->increase_field_width( $jcol, $spaces_needed );
                    }
                }
            }
        }

#--------------------------------------------
        # Loop over fields except last (side comment)
        #--------------------------------------------
        for my $jcol ( 0 .. $jmax - 1 ) {

#-----------------------------------------
            # Decide if this is a new alignment column
            #-----------------------------------------
            my $alignment = $alignments[$jcol];
            my $old_col   = $columns[$jcol];
            my $col       = $alignment->{column};
            $columns[$jcol] = $col;
            if ( defined($old_col) && $old_col != $col ) {
                foreach my $jcol_old ( keys %column_info ) {
                    next if ( $jcol_old < $jcol );
                    my $rcol_hash = $column_info{$jcol_old};
                    if (   $rcol_hash->{signed_count}
                        && $rcol_hash->{unsigned_count} )
                    {
                        end_signed_number_column( $rgroup_lines, $rcol_hash,
                            $ix_line - 1 );
                    }
                    delete $column_info{$jcol_old};
                }
            }

# A new padded sign column can only start at an alignment change
            my $rcol_hash = $column_info{$jcol};

#------------------------------------------------------------
            # Examine this field, looking for signed and unsigned numbers
            #------------------------------------------------------------
            my $field   = $rfields->[$jcol];
            my $pattern = $rpatterns->[$jcol];

my $is_signed_number   = 0;
            my $is_unsigned_number = 0;

#--------------------------------------------------------
            # set $pos_start_number = index in field of digit or sign
            #--------------------------------------------------------
            my $pos_start_number = 0;
            my $char_end_part1   = EMPTY_STRING;
            my $ch_opening       = EMPTY_STRING;

# Set $field_ok to false on encountering any problem
            # Do not pad signed and unsigned hash keys
            my $field_ok = length($field) > 0
              && substr( $rtokens->[$jcol], 0, 2 ) ne '=>';

if ( $field_ok && $pattern ) {

# Split the pattern at the first 'n'
                # $pat1 = pattern before the 'n' (if any)
                # $pat2 = pattern starting at the 'n'
                my ( $pat1, $pat2 );
                my $posq = index( $pattern, 'n' );
                if ( $posq < 0 ) {
                    $field_ok = 0;
                }
                else {
                    # Just look at up to 3 of the pattern characters
                    # We require $pat2 to have one of the known patterns
                    $pat1     = substr( $pattern, 0,     $posq );
                    $pat2     = substr( $pattern, $posq, 3 );
                    $field_ok = $is_leading_sign_pattern{$pat2};
                }

if ($field_ok) {

# If the number starts within the field then we must
                    # find its offset position.
                    if ($pat1) {

# Note: an optimization would be to remember previous
                        # calls for each column and use them if possible, but
                        # benchmarking shows that this is not necessary.
                        # See .ba54 for example coding.
                        ( $pos_start_number, $char_end_part1, $ch_opening ) =
                          split_field( $pat1, $field, $pattern );

$field_ok ||= $pos_start_number;
                    }

if ($field_ok) {

# look for an optional + or - sign
                        my $test_char = substr( $field, $pos_start_number, 1 );
                        my $sign;
                        if ( $is_plus_or_minus{$test_char} ) {
                            $sign = $test_char;
                            $test_char =
                              substr( $field, $pos_start_number + 1, 1 );
                        }

# and a digit
                        if ( $is_digit_char{$test_char} ) {
                            my $field2;
                            if ($sign) {
                                $is_signed_number = 1;
                                $field2 =
                                  substr( $field, $pos_start_number + 1 );
                            }
                            else {
                                $is_unsigned_number = 1;
                                $field2 =
                                  $pos_start_number
                                  ? substr( $field, $pos_start_number )
                                  : $field;
                            }

# Check for match to ending pattern
                            $field_ok =
                              field_matches_end_pattern( $field2, $pat2 );
                        }
                        else {
                            $field_ok = 0;
                        }
                    }
                }
            }

#----------------------
            # Figure out what to do
            #----------------------

# we require a signed or unsigned number field
            # which is not a hash key
            $field_ok &&= ( $is_signed_number || $is_unsigned_number );

# if a column has not started..
            if ( !$rcol_hash ) {

# give up if this is cannot start a new column
                next if ( !$field_ok );

# otherwise continue on to start a new column

}

# if a column has been started...
            else {

# and this cannot be added to it
                if (  !$field_ok
                    || $rcol_hash->{pos_start_number} ne $pos_start_number
                    || $rcol_hash->{char_end_part1} ne $char_end_part1
                    || $rcol_hash->{col} ne $col )
                {

# then end the current column and start over
                    if (   $rcol_hash->{signed_count}
                        && $rcol_hash->{unsigned_count} )
                    {
                        end_signed_number_column( $rgroup_lines, $rcol_hash,
                            $ix_line - 1 );
                    }
                    delete $column_info{$jcol};
                    $rcol_hash = undef;
                }
            }

if (DEBUG_VSN) {
                my $exists = defined($rcol_hash);
                print
"VSN: line=$ix_line change=$jmax_change jcol=$jcol field=$field exists?=$exists unsigned?=$is_unsigned_number signed?=$is_signed_number\n";
            }

#---------------------------------------
            # Either start a new column, if possible
            #---------------------------------------
            if ( !defined($rcol_hash) ) {

next if ( !$field_ok );

my $rsigned_lines = $is_signed_number ? [$ix_line] : [];
                $column_info{$jcol} = {
                    unsigned_count   => $is_unsigned_number,
                    signed_count     => $is_signed_number,
                    pos_start_number => $pos_start_number,
                    char_end_part1   => $char_end_part1,
                    ix_first         => $ix_line,
                    col              => $col,
                    jcol             => $jcol,
                    rsigned_lines    => $rsigned_lines,
                };
            }

#------------------------------
            # or extend the existing column
            #------------------------------
            else {
                $rcol_hash->{unsigned_count} += $is_unsigned_number;
                $rcol_hash->{signed_count}   += $is_signed_number;
                if ($is_signed_number) {
                    push @{ $rcol_hash->{rsigned_lines} }, $ix_line;
                }
            }
        }
    }

#-------------------------------------
    # Loop to finish any remaining columns
    #-------------------------------------
    foreach my $jcol ( keys %column_info ) {
        my $rcol_hash = $column_info{$jcol};
        if ( $rcol_hash->{signed_count} && $rcol_hash->{unsigned_count} ) {
            end_signed_number_column( $rgroup_lines, $rcol_hash, $ix_line );
        }
    }
    return;
} ## end sub pad_signed_number_columns

#########################################
# CODE SECTION 7: Pad Wide Equals Columns
#########################################

use constant DEBUG_WEC => 0;

sub end_wide_equals_column {
    my ( $rgroup_lines, $rcol_hash, $ix_last ) = @_;

# Finish formatting a column of wide equals
    # Given:
    #   $rgroup_lines - the current vertical aligment group of lines
    #   $rcol_hash    - a hash of information about this vertical column
    #   $ix_last      - index of the last line of this vertical column

return unless ($rcol_hash);
    my $jcol      = $rcol_hash->{jcol};
    my $col       = $rcol_hash->{col};
    my $min_width = $rcol_hash->{min_width};
    my $max_width = $rcol_hash->{max_width};
    my $rwidths   = $rcol_hash->{rwidths};
    my $ix_first  = $rcol_hash->{ix_first};

# check for skipped lines, shouldn't happen
    my $nlines = $ix_last - $ix_first + 1;
    my $num    = @{$rwidths};
    if ( $num != $nlines ) {
        my $line    = $rgroup_lines->[$ix_last];
        my $rfields = $line->{'rfields'};
        my $text    = join EMPTY_STRING, @{$rfields};
        DEVEL_MODE && Fault(<<EOM);
We seem to have miscounted lines, please check:
nlines=$nlines
num saved=$num
min width=$min_width
max width=$max_width
j=$jcol
ix_first=$ix_first
ix_last=$ix_last
text=$text
EOM
        return;
    }

#------------------------------------------------------
    # loop over all lines of this vertical alignment column
    #------------------------------------------------------

my (
        $current_alignment, $starting_colp,
        $current_line,      @previous_linked_lines
    );
    foreach my $item ( @{$rwidths} ) {
        my ( $ix, $width ) = @{$item};
        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;
            $current_line          = undef;
            @previous_linked_lines = ();
        }

# handle new rhs alignment
        elsif ( !$current_alignment ) {
            $current_alignment     = $alignment;
            $current_line          = $line;
            $starting_colp         = $colp;
            @previous_linked_lines = ();
        }

# handle change in existing alignment
        elsif ( refaddr($alignment) != refaddr($current_alignment) ) {

# change rhs alignment column - new vertical group on right
            if ( $starting_colp != $colp ) {
                $starting_colp         = $colp;
                @previous_linked_lines = ();
            }
            else {

# Same starting alignment col on right, but different alignment
                # object. See if we must increase width of this new alignment
                # object.
                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};
                    }
                }

# remember the previous line in case we have to go back and
                # increasse its width
                push @previous_linked_lines, $current_line;
            }
            $current_alignment = $alignment;
            $current_line      = $line;
        }
        else {
            # continuing with same alignment
        }

#-----------------------
        # add any needed padding
        #-----------------------
        my $pad = $max_width - $width;
        if ( $pad > 0 ) {

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 ) {
                    $line->increase_field_width( $jcolp, $excess );

# Increase space of any previous linked lines
                    foreach my $line_prev (@previous_linked_lines) {
                        $padding_available =
                          $line_prev->get_available_space_on_right();
                        if ( $excess <= $padding_available ) {
                            $line_prev->increase_field_width( $jcolp, $excess );
                        }
                        else {
                            last;
                        }
                    }
                }
                else {
                    $pad = 0;
                }

}

# Add spaces
            $rfields->[$jcolp] = ( SPACE x $pad ) . $rfields->[$jcolp];
            $rfield_lengths->[$jcolp] += $pad;
        }
    }
    return;
} ## end sub end_wide_equals_column

sub pad_wide_equals_columns {
    my ($rgroup_lines) = @_;

# Given:
    #   $rgroup_lines = the current vertical alignment group of lines
    # Task:
    #   Look for columns of aligned equals tokens, some of which may be
    #   things like '-=', '&&=', etc.  Increase the field length of the
    #   previous field by 1 or 2 spaces where necessary and possible so
    #   that alignment of all '=' occurs.  For example, given

#       $j    /= 2;
    #       $pow2 = $pow2 * $pow2;

# In this case we want to add a leading space '=' term to get
    #       $j    /= 2;
    #       $pow2  = $pow2 * $pow2;

# The logic here is somewhat similar to sub pad_signed_number_columns

return unless ($rOpts_valign_wide_equals);

my %column_info;
    my @columns;

my @alignments = @{ $line->{'ralignments'} };
        my $rfields    = $line->{'rfields'};
        my $rtokens    = $line->{'rtokens'};

#-----------------------------------------------
        # Check for a reduction in the number of columns
        #-----------------------------------------------
        if ( $jmax < $jmax_last ) {

foreach my $jcol ( keys %column_info ) {

# end any stranded columns on the right
                next if ( $jcol < $jmax );
                my $rcol_hash = $column_info{$jcol};
                next unless ($rcol_hash);
                if ( $rcol_hash->{max_width} > $rcol_hash->{min_width} ) {
                    end_wide_equals_column( $rgroup_lines, $rcol_hash,
                        $ix_line - 1 );
                }
                delete $column_info{$jcol};
            }
        }

#--------------------------------------------------
        # Loop over fields except last field (side comment)
        #--------------------------------------------------
        for my $jcol ( 0 .. $jmax - 1 ) {

#-----------------------------------------
            # Decide if this is a new alignment column
            #-----------------------------------------
            my $alignment = $alignments[$jcol];
            my $old_col   = $columns[$jcol];
            my $col       = $alignment->{column};
            $columns[$jcol] = $col;
            if ( defined($old_col) && $old_col != $col ) {
                foreach my $jcol_old ( keys %column_info ) {
                    next if ( $jcol_old < $jcol );
                    my $rcol_hash = $column_info{$jcol_old};
                    if ( $rcol_hash->{max_width} > $rcol_hash->{min_width} ) {
                        end_wide_equals_column( $rgroup_lines, $rcol_hash,
                            $ix_line - 1 );
                    }
                    delete $column_info{$jcol_old};
                }
            }

# A new wide equals column can only start at an alignment change
            my $rcol_hash = $column_info{$jcol};

#------------------------------------------------------
            # Examine this field, looking for equals or wide equals
            #------------------------------------------------------
            my $field_next = $rfields->[ $jcol + 1 ];
            my $token      = $rtokens->[$jcol];

# See if this is an equals alignment group;
            # indicated by alignment token of '=' followed by a digit
            my $len_equals_symbol = 0;
            if (   length($token) > 1
                && substr( $token, 0, 1 ) eq '='
                && $is_digit_char{ substr( $token, 1, 1 ) } )
            {

# find the actual equality symbol which starts the next field
                # i.e. '=' or '**=' or '-=' etc. We just need its length.
                my $pos = index( $field_next, '=' );
                if ( $pos >= 0 && $pos <= 2 ) {
                    $len_equals_symbol = $pos + 1;
                }
            }

# if a column has not started..
            if ( !$rcol_hash ) {

# give up if this is cannot start a new column
                next if ( !$len_equals_symbol );

# otherwise continue on to start a new column

}

# if a column has been started...
            else {

# and this cannot be added to it
                if ( !$len_equals_symbol || $rcol_hash->{col} ne $col ) {

# then end the current column and start over
                    if ( $rcol_hash->{max_width} > $rcol_hash->{min_width} ) {
                        end_wide_equals_column( $rgroup_lines, $rcol_hash,
                            $ix_line - 1 );
                    }
                    delete $column_info{$jcol};
                    $rcol_hash = undef;
                }
            }

if (DEBUG_WEC) {
                my $exists = defined($rcol_hash);
                print
"WEA: line=$ix_line change=$jmax_change jcol=$jcol field=$field_next exists?=$exists equals?=$len_equals_symbol\n";
            }

#---------------------------------------
            # Either start a new column, if possible
            #---------------------------------------
            if ( !defined($rcol_hash) ) {

next if ( !$len_equals_symbol );

$column_info{$jcol} = {
                    ix_first  => $ix_line,
                    col       => $col,
                    jcol      => $jcol,
                    min_width => $len_equals_symbol,
                    max_width => $len_equals_symbol,
                    rwidths   => [ [ $ix_line, $len_equals_symbol ] ],
                };
            }

#------------------------------
            # or extend the existing column
            #------------------------------
            else {
                if ( $len_equals_symbol > $rcol_hash->{max_width} ) {
                    $rcol_hash->{max_width} = $len_equals_symbol;
                }
                if ( $len_equals_symbol < $rcol_hash->{min_width} ) {
                    $rcol_hash->{min_width} = $len_equals_symbol;
                }
                push @{ $rcol_hash->{rwidths} },
                  [ $ix_line, $len_equals_symbol ];
            }
        }
    }

#-------------------------------------
    # Loop to finish any remaining columns
    #-------------------------------------
    foreach my $jcol ( keys %column_info ) {
        my $rcol_hash = $column_info{$jcol};
        if ( $rcol_hash->{max_width} > $rcol_hash->{min_width} ) {
            end_wide_equals_column( $rgroup_lines, $rcol_hash, $ix_line );
        }
    }
    return;
} ## end sub pad_wide_equals_columns

###############################
# CODE SECTION 8: Output Step A
###############################

sub valign_output_step_A {

#------------------------------------------------------------
    # This is Step A in writing vertically aligned lines.
    # The line is prepared according to the alignments which have
    # been found. Then it is shipped to the next step.
    #------------------------------------------------------------

my ( $self, $rinput_hash ) = @_;

my $line                 = $rinput_hash->{line};
    my $min_ci_gap           = $rinput_hash->{min_ci_gap};
    my $do_not_align         = $rinput_hash->{do_not_align};
    my $group_leader_length  = $rinput_hash->{group_leader_length};
    my $extra_leading_spaces = $rinput_hash->{extra_leading_spaces};
    my $level                = $rinput_hash->{level};
    my $maximum_line_length  = $rinput_hash->{maximum_line_length};

my $rfields                   = $line->{'rfields'};
    my $rfield_lengths            = $line->{'rfield_lengths'};
    my $leading_space_count       = $line->{'leading_space_count'};
    my $outdent_long_lines        = $line->{'outdent_long_lines'};
    my $maximum_field_index       = $line->{'jmax'};
    my $rvertical_tightness_flags = $line->{'rvertical_tightness_flags'};
    my $Kend                      = $line->{'Kend'};
    my $level_end                 = $line->{'level_end'};

# Check for valid hash keys at end of lifetime of $line during development
    DEVEL_MODE
      && check_keys( $line, \%valid_LINE_keys,
        "Checking line keys at valign_output_step_A", 1 );

# add any extra spaces
    if ( $leading_space_count > $group_leader_length ) {
        $leading_space_count += $min_ci_gap;
    }

my $str     = $rfields->[0];
    my $str_len = $rfield_lengths->[0];

my @alignments = @{ $line->{'ralignments'} };
    if ( @alignments != $maximum_field_index + 1 ) {

# Shouldn't happen: sub install_new_alignments makes jmax alignments
        my $jmax_alignments = @alignments - 1;
        if (DEVEL_MODE) {
            Fault(
"alignment jmax=$jmax_alignments should equal $maximum_field_index\n"
            );
        }
        $do_not_align = 1;
    }

# loop to concatenate all fields of this line and needed padding
    my $total_pad_count = 0;
    for my $j ( 1 .. $maximum_field_index ) {

# skip zero-length side comments
        last
          if (
            ( $j == $maximum_field_index )
            && ( !defined( $rfields->[$j] )
                || ( $rfield_lengths->[$j] == 0 ) )
          );

# compute spaces of padding before this field
        my $col = $alignments[ $j - 1 ]->{'column'};
        my $pad = $col - ( $str_len + $leading_space_count );

if ($do_not_align) {
            $pad =
              ( $j < $maximum_field_index )
              ? 0
              : $rOpts_minimum_space_to_comment - 1;
        }

# if the -fpsc flag is set, move the side comment to the selected
        # column if and only if it is possible, ignoring constraints on
        # line length and minimum space to comment
        if (   $rOpts_fixed_position_side_comment
            && $j == $maximum_field_index )
        {
            my $newpad = $pad + $rOpts_fixed_position_side_comment - $col - 1;
            if ( $newpad >= 0 ) { $pad = $newpad; }
        }

# accumulate the padding
        if ( $pad > 0 ) { $total_pad_count += $pad; }

# only add padding when we have a finite field;
        # this avoids extra terminal spaces if we have empty fields
        if ( $rfield_lengths->[$j] > 0 ) {
            $str .= SPACE x $total_pad_count;
            $str_len += $total_pad_count;
            $total_pad_count = 0;
            $str .= $rfields->[$j];
            $str_len += $rfield_lengths->[$j];
        }
        else {
            $total_pad_count = 0;
        }
    }

my $side_comment_length = $rfield_lengths->[$maximum_field_index];

# ship this line off
    $self->valign_output_step_B(
        {
            leading_space_count => $leading_space_count + $extra_leading_spaces,
            line                => $str,
            line_length         => $str_len,
            side_comment_length => $side_comment_length,
            outdent_long_lines  => $outdent_long_lines,
            rvertical_tightness_flags => $rvertical_tightness_flags,
            level                     => $level,
            level_end                 => $level_end,
            Kend                      => $Kend,
            maximum_line_length       => $maximum_line_length,
        }
    );
    return;
} ## end sub valign_output_step_A

sub combine_fields {

# We have a group of two lines for which we do not want to align tokens
    # between index $imax_align and the side comment.  So we will delete fields
    # between $imax_align and the side comment.  Alignments have already
    # been set so we have to adjust them.

my ( $line_0, $line_1, $imax_align ) = @_;

if ( !defined($imax_align) ) { $imax_align = -1 }

# First delete the unwanted tokens
    my $jmax_old = $line_0->{'jmax'};
    my @idel     = ( $imax_align + 1 .. $jmax_old - 2 );
    return if ( !@idel );

# Get old alignments before any changes are made
    my @old_alignments = @{ $line_0->{'ralignments'} };

foreach my $line ( $line_0, $line_1 ) {
        delete_selected_tokens( $line, \@idel );
    }

# Now adjust the alignments.  Note that the side comment alignment
    # is always at jmax-1, and there is an ending alignment at jmax.
    my @new_alignments;
    if ( $imax_align >= 0 ) {
        @new_alignments[ 0 .. $imax_align ] =
          @old_alignments[ 0 .. $imax_align ];
    }

my $jmax_new = $line_0->{'jmax'};

$new_alignments[ $jmax_new - 1 ] = $old_alignments[ $jmax_old - 1 ];
    $new_alignments[$jmax_new]       = $old_alignments[$jmax_old];
    $line_0->{'ralignments'}         = \@new_alignments;
    $line_1->{'ralignments'}         = \@new_alignments;
    return;
} ## end sub combine_fields

sub get_output_line_number {

# Return the output line number to external modules.
    # The output line number reported to a caller =
    # the number of items still in the buffer +
    # the number of items written.
    my $self = shift;
    return $self->group_line_count() +
      $self->[_file_writer_object_]->get_output_line_number();
} ## end sub get_output_line_number

###############################
# CODE SECTION 9: Output Step B
###############################

{    ## closure for sub valign_output_step_B

# These are values for a cache used by valign_output_step_B.
    my $cached_line_text;
    my $cached_line_text_length;
    my $cached_line_type;
    my $cached_line_opening_flag;
    my $cached_line_closing_flag;
    my $cached_seqno;
    my $cached_line_valid;
    my $cached_line_leading_space_count;
    my $cached_seqno_string;
    my $cached_line_Kend;
    my $cached_line_maximum_length;

# These are passed to step_C:
    my $seqno_string;
    my $last_nonblank_seqno_string;

sub set_last_nonblank_seqno_string {
        my ($val) = @_;
        $last_nonblank_seqno_string = $val;
        return;
    }

sub get_cached_line_opening_flag {
        return $cached_line_opening_flag;
    }

sub get_cached_line_type {
        return $cached_line_type;
    }

sub set_cached_line_valid {
        my ($val) = @_;
        $cached_line_valid = $val;
        return;
    }

sub get_cached_seqno {
        return $cached_seqno;
    }

sub initialize_step_B_cache {

# valign_output_step_B cache:
        $cached_line_text                = EMPTY_STRING;
        $cached_line_text_length         = 0;
        $cached_line_type                = 0;
        $cached_line_opening_flag        = 0;
        $cached_line_closing_flag        = 0;
        $cached_seqno                    = 0;
        $cached_line_valid               = 0;
        $cached_line_leading_space_count = 0;
        $cached_seqno_string             = EMPTY_STRING;
        $cached_line_Kend                = undef;
        $cached_line_maximum_length      = undef;

# These vars hold a string of sequence numbers joined together used by
        # the cache
        $seqno_string               = EMPTY_STRING;
        $last_nonblank_seqno_string = EMPTY_STRING;
        return;
    } ## end sub initialize_step_B_cache

sub _flush_step_B_cache {
        my ($self) = @_;

# Send any text in the step_B cache on to step_C
        if ($cached_line_type) {
            $seqno_string = $cached_seqno_string;
            $self->valign_output_step_C(
                $seqno_string,
                $last_nonblank_seqno_string,

$cached_line_text,
                $cached_line_leading_space_count,
                $self->[_last_level_written_],
                $cached_line_Kend,
            );
            $cached_line_type           = 0;
            $cached_line_text           = EMPTY_STRING;
            $cached_line_text_length    = 0;
            $cached_seqno_string        = EMPTY_STRING;
            $cached_line_Kend           = undef;
            $cached_line_maximum_length = undef;
        }
        return;
    } ## end sub _flush_step_B_cache

sub handle_cached_line {

my ( $self, $rinput, $leading_string, $leading_string_length ) = @_;

# The cached line will either be:
        # - passed along to step_C, or
        # - or combined with the current line

my $last_level_written = $self->[_last_level_written_];

my $leading_space_count       = $rinput->{leading_space_count};
        my $str                       = $rinput->{line};
        my $str_length                = $rinput->{line_length};
        my $rvertical_tightness_flags = $rinput->{rvertical_tightness_flags};
        my $level                     = $rinput->{level};
        my $level_end                 = $rinput->{level_end};
        my $maximum_line_length       = $rinput->{maximum_line_length};

my ( $open_or_close, $seqno_beg );
        if ($rvertical_tightness_flags) {

$open_or_close = $rvertical_tightness_flags->{_vt_type};
            $seqno_beg     = $rvertical_tightness_flags->{_vt_seqno_beg};
        }

# Dump an invalid cached line
        if ( !$cached_line_valid ) {
            $self->valign_output_step_C(
                $seqno_string,
                $last_nonblank_seqno_string,

$cached_line_text,
                $cached_line_leading_space_count,
                $last_level_written,
                $cached_line_Kend,
            );
        }

# Handle cached line ending in OPENING tokens
        elsif ( $cached_line_type == 1 || $cached_line_type == 3 ) {

my $gap = $leading_space_count - $cached_line_text_length;

# handle option of just one tight opening per line:
            if ( $cached_line_opening_flag == 1 ) {
                if ( defined($open_or_close) && $open_or_close == 1 ) {
                    $gap = -1;
                }
            }

# Do not join the lines if this might produce a one-line
            # container which exceeds the maximum line length.  This is
            # necessary prevent blinking, particularly with the combination
            # -xci -pvt=2.  In that case a one-line block alternately forms
            # and breaks, causing -xci to alternately turn on and off (case
            # b765).
            # Patched to fix cases b656 b862 b971 b972: always do the check
            # if the maximum line length changes (due to -vmll).
            if (
                $gap >= 0
                && ( $maximum_line_length != $cached_line_maximum_length
                    || ( defined($level_end) && $level > $level_end ) )
              )
            {
                my $test_line_length =
                  $cached_line_text_length + $gap + $str_length;

# Add a small tolerance in the length test (fixes case b862)
                if ( $test_line_length > $cached_line_maximum_length - 2 ) {
                    $gap = -1;
                }
            }

if ( $gap >= 0 && defined($seqno_beg) ) {
                $maximum_line_length   = $cached_line_maximum_length;
                $leading_string        = $cached_line_text . SPACE x $gap;
                $leading_string_length = $cached_line_text_length + $gap;
                $leading_space_count   = $cached_line_leading_space_count;
                $seqno_string = $cached_seqno_string . ':' . $seqno_beg;
                $level        = $last_level_written;
            }
            else {
                $self->valign_output_step_C(
                    $seqno_string,
                    $last_nonblank_seqno_string,

$cached_line_text,
                    $cached_line_leading_space_count,
                    $last_level_written,
                    $cached_line_Kend,
                );
            }
        }

# Handle cached line ending in CLOSING tokens
        else {
            my $test_line =
              $cached_line_text . SPACE x $cached_line_closing_flag . $str;
            my $test_line_length =
              $cached_line_text_length +
              $cached_line_closing_flag +
              $str_length;
            if (

# The new line must start with container
                $seqno_beg

# The container combination must be okay..
                && (

# okay to combine like types
                    ( $open_or_close == $cached_line_type )

# closing block brace may append to non-block
                    || ( $cached_line_type == 2 && $open_or_close == 4 )

# something like ');'
                    || ( !$open_or_close && $cached_line_type == 2 )

)

# The combined line must fit
                && ( $test_line_length <= $cached_line_maximum_length )
              )
            {

$seqno_string = $cached_seqno_string . ':' . $seqno_beg;

# Patch to outdent closing tokens ending # in ');' If we
                # are joining a line like ');' to a previous stacked set of
                # closing tokens, then decide if we may outdent the
                # combined stack to the indentation of the ');'.  Since we
                # should not normally outdent any of the other tokens more
                # than the indentation of the lines that contained them, we
                # will only do this if all of the corresponding opening
                # tokens were on the same line.  This can happen with -sot
                # and -sct.

# For example, it is ok here:
                #   __PACKAGE__->load_components( qw(
                #         PK::Auto
                #         Core
                #   ));
                #
                # But, for example, we do not outdent in this example
                # because that would put the closing sub brace out farther
                # than the opening sub brace:
                #
                #   perltidy -sot -sct
                #   $c->Tk::bind(
                #       '<Control-f>' => sub {
                #           my ($c) = @_;
                #           my $e = $c->XEvent;
                #           itemsUnderArea $c;
                #       } );
                #
                if (   $str =~ /^\);/
                    && $cached_line_text =~ /^[\)\}\]\s]*$/ )
                {

# The way to tell this is if the stacked sequence
                    # numbers of this output line are the reverse of the
                    # stacked sequence numbers of the previous non-blank
                    # line of sequence numbers.  So we can join if the
                    # previous nonblank string of tokens is the mirror
                    # image.  For example if stack )}] is 13:8:6 then we
                    # are looking for a leading stack like [{( which
                    # is 6:8:13. We only need to check the two ends,
                    # because the intermediate tokens must fall in order.
                    # Note on speed: having to split on colons and
                    # eliminate multiple colons might appear to be slow,
                    # but it's not an issue because we almost never come
                    # through here.  In a typical file we don't.

$seqno_string               =~ s/^:+//;
                    $last_nonblank_seqno_string =~ s/^:+//;
                    $seqno_string               =~ s/:+/:/g;
                    $last_nonblank_seqno_string =~ s/:+/:/g;

# how many spaces can we outdent?
                    my $diff =
                      $cached_line_leading_space_count - $leading_space_count;
                    if (   $diff > 0
                        && length($seqno_string)
                        && length($last_nonblank_seqno_string) ==
                        length($seqno_string) )
                    {
                        my @seqno_last =
                          ( split /:/, $last_nonblank_seqno_string );
                        my @seqno_now = ( split /:/, $seqno_string );
                        if (   @seqno_now
                            && @seqno_last
                            && $seqno_now[-1] == $seqno_last[0]
                            && $seqno_now[0] == $seqno_last[-1] )
                        {

# OK to outdent ..
                            # for absolute safety, be sure we only remove
                            # whitespace
                            my $ws = substr( $test_line, 0, $diff );
                            if ( ( length($ws) == $diff )
                                && $ws =~ /^\s+$/ )
                            {

$test_line = substr( $test_line, $diff );
                                $cached_line_leading_space_count -= $diff;
                                $last_level_written =
                                  $self->level_change(
                                    $cached_line_leading_space_count,
                                    $diff, $last_level_written );
                                $self->reduce_valign_buffer_indentation($diff);
                            }

# shouldn't happen, but not critical:
                            ##else {
                            ## ERROR transferring indentation here
                            ##}
                        }
                    }
                }

# Change the args to look like we received the combined line
                $str                   = $test_line;
                $str_length            = $test_line_length;
                $leading_string        = EMPTY_STRING;
                $leading_string_length = 0;
                $leading_space_count   = $cached_line_leading_space_count;
                $level                 = $last_level_written;
                $maximum_line_length   = $cached_line_maximum_length;
            }
            else {
                $self->valign_output_step_C(
                    $seqno_string,
                    $last_nonblank_seqno_string,

$cached_line_text,
                    $cached_line_leading_space_count,
                    $last_level_written,
                    $cached_line_Kend,
                );
            }
        }
        return ( $str, $str_length, $leading_string, $leading_string_length,
            $leading_space_count, $level, $maximum_line_length );

} ## end sub handle_cached_line

sub valign_output_step_B {

#---------------------------------------------------------
        # This is Step B in writing vertically aligned lines.
        # Vertical tightness is applied according to preset flags.
        # In particular this routine handles stacking of opening
        # and closing tokens.
        #---------------------------------------------------------

my ( $self, $rinput ) = @_;

my $leading_space_count       = $rinput->{leading_space_count};
        my $str                       = $rinput->{line};
        my $str_length                = $rinput->{line_length};
        my $side_comment_length       = $rinput->{side_comment_length};
        my $outdent_long_lines        = $rinput->{outdent_long_lines};
        my $rvertical_tightness_flags = $rinput->{rvertical_tightness_flags};
        my $level                     = $rinput->{level};
        my $level_end                 = $rinput->{level_end};
        my $Kend                      = $rinput->{Kend};
        my $maximum_line_length       = $rinput->{maximum_line_length};

# Useful -gcs test cases for wide characters are
        # perl527/(method.t.2, reg_mesg.t, mime-header.t)

# handle outdenting of long lines:
        my $is_outdented_line;
        if ($outdent_long_lines) {
            my $excess =
              $str_length -
              $side_comment_length +
              $leading_space_count -
              $maximum_line_length;
            if ( $excess > 0 ) {
                $leading_space_count = 0;
                my $file_writer_object = $self->[_file_writer_object_];
                my $last_outdented_line_at =
                  $file_writer_object->get_output_line_number();
                $self->[_last_outdented_line_at_] = $last_outdented_line_at;

my $outdented_line_count = $self->[_outdented_line_count_];
                if ( !$outdented_line_count ) {
                    $self->[_first_outdented_line_at_] =
                      $last_outdented_line_at;
                }
                $outdented_line_count++;
                $self->[_outdented_line_count_] = $outdented_line_count;
                $is_outdented_line = 1;
            }
        }

# Make preliminary leading whitespace.  It could get changed
        # later by entabbing, so we have to keep track of any changes
        # to the leading_space_count from here on.
        my $leading_string =
          $leading_space_count > 0
          ? ( SPACE x $leading_space_count )
          : EMPTY_STRING;
        my $leading_string_length = length($leading_string);

# Unpack any recombination data; it was packed by
        # sub 'Formatter::set_vertical_tightness_flags'

# old   hash              Meaning
        # index key
        #
        # 0   _vt_type:           1=opening non-block    2=closing non-block
        #                         3=opening block brace  4=closing block brace
        #
        # 1a  _vt_opening_flag:  1=no multiple steps, 2=multiple steps ok
        # 1b  _vt_closing_flag:    spaces of padding to use if closing
        # 2   _vt_seqno:          sequence number of container
        # 3   _vt_valid flag:     do not append if this flag is false. Will be
        #           true if appropriate -vt flag is set.  Otherwise, Will be
        #           made true only for 2 line container in parens with -lp
        # 4   _vt_seqno_beg:      sequence number of first token of line
        # 5   _vt_seqno_end:      sequence number of last token of line
        # 6   _vt_min_lines:      min number of lines for joining opening cache,
        #                           0=no constraint
        # 7   _vt_max_lines:      max number of lines for joining opening cache,
        #                           0=no constraint

my ( $open_or_close, $opening_flag, $closing_flag, $seqno, $valid,
            $seqno_beg, $seqno_end );
        if ($rvertical_tightness_flags) {

$open_or_close = $rvertical_tightness_flags->{_vt_type};
            $opening_flag  = $rvertical_tightness_flags->{_vt_opening_flag};
            $closing_flag  = $rvertical_tightness_flags->{_vt_closing_flag};
            $seqno         = $rvertical_tightness_flags->{_vt_seqno};
            $valid         = $rvertical_tightness_flags->{_vt_valid_flag};
            $seqno_beg     = $rvertical_tightness_flags->{_vt_seqno_beg};
            $seqno_end     = $rvertical_tightness_flags->{_vt_seqno_end};
        }

$seqno_string = $seqno_end;

# handle any cached line ..
        # either append this line to it or write it out
        # Note: the function length() is used in this next test out of caution.
        # All testing has shown that the variable $cached_line_text_length is
        # correct, but its calculation is complex and a loss of cached text
        # would be a disaster.
        if ( length($cached_line_text) ) {

(
                $str,
                $str_length,
                $leading_string,
                $leading_string_length,
                $leading_space_count,
                $level,
                $maximum_line_length

) = $self->handle_cached_line( $rinput, $leading_string,
                $leading_string_length );

$cached_line_type           = 0;
            $cached_line_text           = EMPTY_STRING;
            $cached_line_text_length    = 0;
            $cached_line_Kend           = undef;
            $cached_line_maximum_length = undef;

}

# make the line to be written
        my $line        = $leading_string . $str;
        my $line_length = $leading_string_length + $str_length;

# Safety check: be sure that a line to be cached as a stacked block
        # brace line ends in the appropriate opening or closing block brace.
        # This should always be the case if the caller set flags correctly.
        # Code '3' is for -sobb, code '4' is for -scbb.
        if ($open_or_close) {
            if (   $open_or_close == 3 && $line !~ /\{\s*$/
                || $open_or_close == 4 && $line !~ /\}\s*$/ )
            {
                $open_or_close = 0;
            }
        }

# write or cache this line ...
        # fix for case b999: do not cache an outdented line
        # fix for b1378: do not cache an empty line
        if (  !$open_or_close
            || $side_comment_length > 0
            || $is_outdented_line
            || !$line_length )
        {
            $self->valign_output_step_C(
                $seqno_string,
                $last_nonblank_seqno_string,

$line,
                $leading_space_count,
                $level,
                $Kend,
            );
        }
        else {
            $cached_line_text                = $line;
            $cached_line_text_length         = $line_length;
            $cached_line_type                = $open_or_close;
            $cached_line_opening_flag        = $opening_flag;
            $cached_line_closing_flag        = $closing_flag;
            $cached_seqno                    = $seqno;
            $cached_line_valid               = $valid;
            $cached_line_leading_space_count = $leading_space_count;
            $cached_seqno_string             = $seqno_string;
            $cached_line_Kend                = $Kend;
            $cached_line_maximum_length      = $maximum_line_length;
        }

$self->[_last_level_written_]       = $level;
        $self->[_last_side_comment_length_] = $side_comment_length;
        return;
    } ## end sub valign_output_step_B
}

################################
# CODE SECTION 10: Output Step C
################################

{    ## closure for sub valign_output_step_C

# Vertical alignment buffer used by valign_output_step_C
    my $valign_buffer_filling;
    my @valign_buffer;

sub initialize_valign_buffer {
        @valign_buffer         = ();
        $valign_buffer_filling = EMPTY_STRING;
        return;
    }

sub dump_valign_buffer {
        my ($self) = @_;

# Send all lines in the current buffer on to step_D
        if (@valign_buffer) {
            foreach (@valign_buffer) {
                $self->valign_output_step_D( @{$_} );
            }
            @valign_buffer = ();
        }
        $valign_buffer_filling = EMPTY_STRING;
        return;
    } ## end sub dump_valign_buffer

sub reduce_valign_buffer_indentation {

my ( $self, $diff ) = @_;

# Reduce the leading indentation of lines in the current
        # buffer by $diff spaces
        if ( $valign_buffer_filling && $diff ) {
            my $max_valign_buffer = @valign_buffer;
            foreach my $i ( 0 .. $max_valign_buffer - 1 ) {
                my ( $line, $leading_space_count, $level, $Kend ) =
                  @{ $valign_buffer[$i] };
                my $ws = substr( $line, 0, $diff );
                if ( ( length($ws) == $diff ) && $ws =~ /^\s+$/ ) {
                    $line = substr( $line, $diff );
                }
                if ( $leading_space_count >= $diff ) {
                    $leading_space_count -= $diff;
                    $level =
                      $self->level_change( $leading_space_count, $diff,
                        $level );
                }
                $valign_buffer[$i] =
                  [ $line, $leading_space_count, $level, $Kend ];
            }
        }
        return;
    } ## end sub reduce_valign_buffer_indentation

sub valign_output_step_C {

#-----------------------------------------------------------------------
        # This is Step C in writing vertically aligned lines.
        # Lines are either stored in a buffer or passed along to the next step.
        # The reason for storing lines is that we may later want to reduce their
        # indentation when -sot and -sct are both used.
        #-----------------------------------------------------------------------
        my (
            $self,
            $seqno_string,
            $last_nonblank_seqno_string,

@args_to_D,
        ) = @_;

# Dump any saved lines if we see a line with an unbalanced opening or
        # closing token.
        $self->dump_valign_buffer()
          if ( $seqno_string && $valign_buffer_filling );

# Either store or write this line
        if ($valign_buffer_filling) {
            push @valign_buffer, [@args_to_D];
        }
        else {
            $self->valign_output_step_D(@args_to_D);
        }

# For lines starting or ending with opening or closing tokens..
        if ($seqno_string) {
            $last_nonblank_seqno_string = $seqno_string;
            set_last_nonblank_seqno_string($seqno_string);

# Start storing lines when we see a line with multiple stacked
            # opening tokens.
            # patch for RT #94354, requested by Colin Williams
            if (   index( $seqno_string, ':' ) >= 0
                && $seqno_string =~ /^\d+(\:+\d+)+$/
                && $args_to_D[0] !~ /^[\}\)\]\:\?]/ )
            {

# This test is efficient but a little subtle: The first test
                # says that we have multiple sequence numbers and hence
                # multiple opening or closing tokens in this line.  The second
                # part of the test rejects stacked closing and ternary tokens.
                # So if we get here then we should have stacked unbalanced
                # opening tokens.

# Here is a complex example:

# Foo($Bar[0], {  # (side comment)
                #     baz => 1,
                # });

# The first line has sequence 6::4.  It does not begin with
                # a closing token or ternary, so it passes the test and must be
                # stacked opening tokens.

# The last line has sequence 4:6 but is a stack of closing
                # tokens, so it gets rejected.

# Note that the sequence number of an opening token for a qw
                # quote is a negative number and will be rejected.  For
                # example, for the following line: skip_symbols([qw(
                # $seqno_string='10:5:-1'.  It would be okay to accept it but I
                # decided not to do this after testing.

$valign_buffer_filling = $seqno_string;

}
        }
        return;
    } ## end sub valign_output_step_C
}

###############################
# CODE SECTION 11: Output Step D
###############################

sub add_leading_tabs {

my ( $line, $leading_space_count, $level ) = @_;

# Convert leading whitespace to use tabs if -et or -t are set

# Given:
    #   $line = the line of text to be written, without any tabs
    #   $leading_whitespace = expected number of leading blank spaces
    #   $level = indentation level (needed for -t)

# Return:
    #   $line = the line with possible leading tabs

my $trimmed_line = $line;
    $trimmed_line =~ s/^ [^\S\n]+ //gxm;

# Check for discrepancy in actual leading white spaces with estimate
    if ( length($line) != length($trimmed_line) + $leading_space_count ) {

# If $leading_space_count is zero, then this routine must not
        # be called because we might be in a quote of some kind
        if ( $leading_space_count <= 0 ) {
            DEVEL_MODE && Fault(<<EOM);
should not be here with leading space count = $leading_space_count
EOM
            return $line;
        }

my $leading_space_count_test = length($line) - length($trimmed_line);

# Skip tabbing if actual whitespace is less than expected
        if ( $leading_space_count_test < $leading_space_count ) {
            DEBUG_TABS
              && warning(<<EOM);
Error entabbing: expected count=$leading_space_count but only found $leading_space_count_test for line:
'$line'
EOM
            return $line;
        }

# Use actual whitespace if it exceeds prediction. This mainly
        # occurs at hanging side comments.
        $leading_space_count = $leading_space_count_test;
    }

#----------------------------------
    # Handle --entab-leading-whitespace
    #----------------------------------
    if ($rOpts_entab_leading_whitespace) {

my $space_count =
          $leading_space_count % $rOpts_entab_leading_whitespace;
        my $tab_count =
          int( $leading_space_count / $rOpts_entab_leading_whitespace );
        my $leading_string = "\t" x $tab_count . SPACE x $space_count;
        $line = $leading_string . $trimmed_line;
    }

#-----------------------------------------------
    # Handle -t (one tab per level; not recommended)
    #-----------------------------------------------
    elsif ( $rOpts_tabs && $level ) {

my $leading_string = ( "\t" x $level );
        my $space_count = $leading_space_count - $level * $rOpts_indent_columns;

# shouldn't happen:
        if ( $space_count < 0 ) {

# But it could be an outdented comment
            if ( $line !~ /^\s*#/ ) {
                DEBUG_TABS
                  && warning(
"Error entabbing in valign_output_step_D: for level=$level count=$leading_space_count\n"
                  );
            }
            $leading_string = ( SPACE x $leading_space_count );
        }
        else {
            $leading_string .= ( SPACE x $space_count );
        }
        $line = $leading_string . $trimmed_line;
    }

# nothing to do; we should have skipped a call to this sub
    else {
        if (DEVEL_MODE) {
            Fault(
"in tab sub but neither -t nor -et set: check flag 'require_tabs'\n"
            );
        }
    }
    return $line;
} ## end sub add_leading_tabs

sub valign_output_step_D {

#----------------------------------------------------------------
    # This is Step D in writing vertically aligned lines.
    # It is the end of the vertical alignment pipeline.
    # Write one vertically aligned line of code to the output object.
    #----------------------------------------------------------------

my ( $self, $line, $leading_space_count, $level, $Kend ) = @_;

# Convert leading whitespace to use tabs if requested.
    if ( $require_tabs && $leading_space_count > 0 ) {
        $line = add_leading_tabs( $line, $leading_space_count, $level );
    }

my $file_writer_object = $self->[_file_writer_object_];
    $file_writer_object->write_code_line( $line . "\n", $Kend );

return;
} ## end sub valign_output_step_D

##########################
# CODE SECTION 12: Summary
##########################

sub report_anything_unusual {
    my $self = shift;

my $outdented_line_count = $self->[_outdented_line_count_];
    if ( $outdented_line_count > 0 ) {
        write_logfile_entry(
            "$outdented_line_count long lines were outdented:\n");
        my $first_outdented_line_at = $self->[_first_outdented_line_at_];
        write_logfile_entry(
            "  First at output line $first_outdented_line_at\n");

if ( $outdented_line_count > 1 ) {
            my $last_outdented_line_at = $self->[_last_outdented_line_at_];
            write_logfile_entry(
                "   Last at output line $last_outdented_line_at\n");
        }
        write_logfile_entry(
            "  use -noll to prevent outdenting, -l=n to increase line length\n"
        );
        write_logfile_entry("\n");
    }
    return;
} ## end sub report_anything_unusual

} ## end package Perl::Tidy::VerticalAligner
1;

Cancel