File Coverage

blib/lib/Perl/Tidy/Tokenizer.pm

Criterion	Covered	Total	%
statement	2691	3715	72.4
branch	1261	1934	65.2
condition	755	1199	62.9
subroutine	168	202	83.1
pod	0	147	0.0
total	4875	7197	67.7

package Perl::Tidy::Tokenizer;

#####################################################################
#
# Perl::Tidy::Tokenizer reads a source and breaks it into a stream of tokens
#
# Usage Outline:
#
#   STEP 1: initialize or re-initialize Tokenizer with user options
#     Perl::Tidy::Tokenizer::check_options($rOpts);
#
#   STEP 2: create a tokenizer for a specific input source object
#     my $tokenizer = Perl::Tidy::Tokenizer->new(
#         source_object      => $source,
#         ...
#     );
#
#   STEP 3: get and process each tokenized 'line' (a hash ref of token info)
#    while ( my $line = $tokenizer->get_line() ) {
#        $formatter->write_line($line);
#    }
#
#   STEP 4: report errors
#    my $severe_error = $tokenizer->report_tokenization_errors();
#
# The source object can be a STRING ref, an ARRAY ref, or an object with a
# get_line() method which supplies one line (a character string) perl call.
#
# NOTE: This is not a real class.  Only one tokenizer my be used.
#
########################################################################

use strict;
use warnings;
use English qw( -no_match_vars );

our $VERSION = '20260705';

use Carp;

use constant DEVEL_MODE       => 0;
use constant DEBUG_GUESS_MODE => 0;
use constant EMPTY_STRING     => q{};
use constant SPACE            => q{ };
use constant COMMA            => q{,};
use constant BACKSLASH        => q{\\};

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

# List of hash keys to prevent -duk from listing them.
# (note the backtick in this list)
my @unique_hash_keys_uu = qw( ` RPerl _rtype_sequence _ending_in_quote );

# Parent sequence number of tree of containers; must be 1
use constant SEQ_ROOT => 1;

# Defaults for guessing old indentation
use constant INDENT_COLUMNS_DEFAULT => 4;
use constant TAB_SIZE_DEFAULT       => 8;

# Decimal values of some ascii characters for quick checks
use constant ORD_TAB           => 9;
use constant ORD_SPACE         => 32;
use constant ORD_PRINTABLE_MIN => 33;
use constant ORD_PRINTABLE_MAX => 126;

# GLOBAL VARIABLES which change during tokenization:
# These could also be stored in $self but it is more convenient and
# efficient to make them global lexical variables.
# INITIALIZER: sub prepare_for_a_new_file
my (

    $brace_depth,
    $context,
    $current_package,
    $last_nonblank_block_type,
    $last_nonblank_token,
    $last_nonblank_type,
    $next_sequence_number,
    $paren_depth,
    $rbrace_context,
    $rbrace_package,
    $rbrace_structural_type,
    $rbrace_type,
    $rcurrent_depth,
    $rcurrent_sequence_number,
    $ris_lexical_sub,
    $rdepth_array,
    $ris_block_function,
    $ris_block_list_function,
    $ris_constant,
    $ris_user_function,
    $rnested_statement_type,
    $rnested_ternary_flag,
    $rparen_semicolon_count,
    $rparen_vars,
    $rparen_type,
    $rsaw_function_definition,
    $rsaw_use_module,
    $rsquare_bracket_structural_type,
    $rsquare_bracket_type,
    $rstarting_line_of_current_depth,
    $rtotal_depth,
    $ruser_function_prototype,
    $square_bracket_depth,
    $statement_type,
    $total_depth,
);

my (

    # GLOBAL CONSTANTS for routines in this package,
    # INITIALIZER: BEGIN block.
    %can_start_digraph,
    %expecting_operator_token,
    %expecting_operator_types,
    %expecting_term_token,
    %expecting_term_types,
    %is_block_operator,
    %is_digraph,
    %is_file_test_operator,
    %is_if_elsif_unless,
    %is_if_elsif_unless_case_when,
    %is_indirect_object_taker,
    %is_keyword_rejecting_question_as_pattern_delimiter,
    %is_keyword_rejecting_slash_as_pattern_delimiter,
    %is_keyword_taking_list,
    %is_keyword_taking_optional_arg,
    %is_q_qq_qw_qx_qr_s_y_tr_m,
    %is_q_qq_qx_qr_s_y_tr_m,
    %quote_modifiers,
    %is_semicolon_or_t,
    %is_sort_map_grep,
    %is_sort_map_grep_eval_do_sub,
    %is_tetragraph,
    %is_trigraph,
    %is_valid_token_type,
    %other_line_endings,
    %is_binary_operator_type,
    %is_binary_keyword,
    %is_binary_or_unary_operator_type,
    %is_binary_or_unary_keyword,
    %is_not_a_TERM_producer_type,
    @closing_brace_names,
    @opening_brace_names,

    # GLOBAL CONSTANT hash lookup table of operator expected values
    # INITIALIZER: BEGIN block
    %op_expected_table,

    # GLOBAL VARIABLES which are constant after being configured.
    # INITIALIZER: BEGIN block and modified by sub check_options
    %is_code_block_token,
    %is_zero_continuation_block_type,
    %is_keyword,
    %is_TERM_keyword,
    %is_my_our_state,
    %is_package,
    %matching_end_token,

    # INITIALIZER: sub check_options
    $code_skipping_pattern_begin,
    $code_skipping_pattern_end,
    $format_skipping_pattern_begin,
    $format_skipping_pattern_end,

    $rOpts_code_skipping,
    $rOpts_code_skipping_begin,
    $rOpts_format_skipping,
    $rOpts_format_skipping_begin,
    $rOpts_format_skipping_end,
    $rOpts_starting_indentation_level,
    $rOpts_indent_columns,
    $rOpts_look_for_hash_bang,
    $rOpts_look_for_autoloader,
    $rOpts_look_for_selfloader,
    $rOpts_trim_qw,
    $rOpts_extended_syntax,
    $rOpts_continuation_indentation,
    $rOpts_outdent_labels,
    $rOpts_maximum_level_errors,
    $rOpts_maximum_unexpected_errors,
    $rOpts_indent_closing_brace,
    $rOpts_non_indenting_braces,
    $rOpts_non_indenting_brace_prefix,
    $rOpts_whitespace_cycle,

    $tabsize,
    %is_END_DATA_format_sub,
    %is_grep_alias,
    %is_sub,
    $guess_if_method,
);

# possible values of operator_expected()
use constant TERM     => -1;
use constant UNKNOWN  => 0;
use constant OPERATOR => 1;

# possible values of context
use constant SCALAR_CONTEXT  => -1;
use constant UNKNOWN_CONTEXT => 0;
use constant LIST_CONTEXT    => 1;

# Maximum number of little messages; probably need not be changed.
use constant MAX_NAG_MESSAGES => 6;

BEGIN {

    # Array index names for $self.
    # Do not combine with other BEGIN blocks (c101).
    my $i = 0;
    use constant {
        _rhere_target_list_                  => $i++,
        _in_here_doc_                        => $i++,
        _here_doc_target_                    => $i++,
        _here_quote_character_               => $i++,
        _in_data_                            => $i++,
        _in_end_                             => $i++,
        _in_format_                          => $i++,
        _in_error_                           => $i++,
        _do_not_format_                      => $i++,
        _warning_count_                      => $i++,
        _html_tag_count_                     => $i++,
        _in_pod_                             => $i++,
        _in_code_skipping_                   => $i++,
        _in_format_skipping_                 => $i++,
        _rformat_skipping_list_              => $i++,
        _in_attribute_list_                  => $i++,
        _in_quote_                           => $i++,
        _quote_target_                       => $i++,
        _line_start_quote_                   => $i++,
        _starting_level_                     => $i++,
        _know_starting_level_                => $i++,
        _last_line_number_                   => $i++,
        _saw_perl_dash_P_                    => $i++,
        _saw_perl_dash_w_                    => $i++,
        _saw_use_strict_                     => $i++,
        _saw_brace_error_                    => $i++,
        _hit_bug_                            => $i++,
        _look_for_autoloader_                => $i++,
        _look_for_selfloader_                => $i++,
        _saw_autoloader_                     => $i++,
        _saw_selfloader_                     => $i++,
        _saw_hash_bang_                      => $i++,
        _saw_end_                            => $i++,
        _saw_data_                           => $i++,
        _saw_negative_indentation_           => $i++,
        _started_tokenizing_                 => $i++,
        _debugger_object_                    => $i++,
        _diagnostics_object_                 => $i++,
        _logger_object_                      => $i++,
        _save_logfile_                       => $i++,
        _unexpected_error_count_             => $i++,
        _started_looking_for_here_target_at_ => $i++,
        _nearly_matched_here_target_at_      => $i++,
        _line_of_text_                       => $i++,
        _rlower_case_labels_at_              => $i++,
        _maximum_level_                      => $i++,
        _true_brace_error_count_             => $i++,
        _rOpts_                              => $i++,
        _rinput_lines_                       => $i++,
        _input_line_index_next_              => $i++,
        _rtrimmed_input_lines_               => $i++,
        _rclosing_brace_indentation_hash_    => $i++,
        _show_indentation_table_             => $i++,
        _rnon_indenting_brace_stack_         => $i++,
        _rseqno_at_depth_                    => $i++,
        _rbareword_info_                     => $i++,
        _rsaw_unknown_syntax_in_seqno_       => $i++,
    };
} ## end BEGIN

{    ## closure for subs to count instances

    # methods to count instances
    my $_count = 0;
    sub get_count        { return $_count; }
    sub _increment_count { return ++$_count }
    sub _decrement_count { return --$_count }
}

sub DESTROY {
    my $self = shift;
    _decrement_count();
    return;
}

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 Die {
    my ($msg) = @_;
    Perl::Tidy::Die($msg);
    croak "unexpected return from Perl::Tidy::Die";
}

sub Warn {
    my ($msg) = @_;
    Perl::Tidy::Warn($msg);
    return;
}

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_uu, $filename0_uu, $line0, $subroutine0_uu ) = caller(0);
    my ( $package1_uu, $filename1, $line1, $subroutine1 )       = caller(1);
    my ( $package2_uu, $filename2_uu, $line2_uu, $subroutine2 ) = caller(2);
    my $pkg               = __PACKAGE__;
    my $input_stream_name = Perl::Tidy::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

    croak "unexpected return from sub Die";
} ## end sub Fault

sub bad_pattern {
    my ($pattern) = @_;

    # Return true if a regex pattern has an error
    # Note: Formatter.pm also has a copy of this
    my $regex_uu = eval { qr/$pattern/ };
    return $EVAL_ERROR;
} ## end sub bad_pattern

sub make_skipping_pattern {
    my ( $rOpts, $opt_name, $default ) = @_;

    # Make regex patterns for the format-skipping and code-skipping options
    my $param = $rOpts->{$opt_name};
    if ( !$param ) { $param = $default }
    $param =~ s/^\s+//;
    if ( $param !~ /^#/ ) {
        Die("ERROR: the $opt_name parameter '$param' must begin with '#'\n");
    }

    # Note that the ending \s will match a newline
    my $pattern = '^\s*' . $param . '\s';
    if ( bad_pattern($pattern) ) {
        Die(
"ERROR: the $opt_name parameter '$param' causes the invalid regex '$pattern'\n"
        );
    }
    return $pattern;
} ## end sub make_skipping_pattern

sub check_options {

    # Check and pre-process tokenizer parameters
    my $rOpts = shift;

    %is_sub = ();
    $is_sub{'sub'} = 1;

    %is_END_DATA_format_sub = (
        '__END__'  => 1,
        '__DATA__' => 1,
        'format'   => 1,
        'sub'      => 1,
    );

    # Install any aliases to 'sub'
    if ( $rOpts->{'sub-alias-list'} ) {

        # Note that any 'sub-alias-list' has been preprocessed to
        # be a trimmed, space-separated list which includes 'sub'
        # for example, it might be 'sub method fun'
        my @sub_alias_list = split /\s+/, $rOpts->{'sub-alias-list'};
        foreach my $word (@sub_alias_list) {
            $is_sub{$word}                 = 1;
            $is_END_DATA_format_sub{$word} = 1;
        }
    }

    # Set global flag to say if we have to guess if bareword 'method' is
    # a sub when 'method' is in %is_sub. This will be true unless:
    #   (1) the user entered 'method' as sub alias, or
    #   (2) the user set --use-feature=class
    # In these two cases we can assume that 'method' is a sub alias.
    $guess_if_method = 1;
    if ( $is_sub{'method'} ) { $guess_if_method = 0 }

    #------------------------------------------------
    # Update hash values for any -use-feature options
    #------------------------------------------------

    my $use_feature_class = 1;

    my $str = $rOpts->{'use-feature'};
    if ( defined($str) && length($str) ) {
        $str =~ s/^\s+//;
        $str =~ s/\s+$//;
        if ( !length($str) ) {
            ## all spaces
        }
        elsif ( $str =~ /\bnoclass\b/ ) {
            $use_feature_class = 0;
        }
        elsif ( $str =~ /\bclass\b/ ) {
            $guess_if_method = 0;
        }
        else {
            # At present, only 'class' and 'noclass' are valid strings
            # This is just a Warn, for testing, but will eventually be Die
            Warn(
"Unexpected text in --use-feature: expecting 'class' or 'noclass'\n"
            );
        }
    }

    # These are the main updates for this option. There are additional
    # changes elsewhere, usually indicated with a comment 'rt145706'

    # Update hash values for use_feature=class, added for rt145706
    # see 'perlclass.pod'

    # IMPORTANT: We are changing global hash values initially set in a BEGIN
    # block.  Values must be defined (true or false) for each of these new
    # words whether true or false. Otherwise, programs using the module which
    # change options between runs (such as test code) will have
    # incorrect settings and fail.

    # There are 4 new keywords:

    # 'class' - treated specially as generalization of 'package'
    # Note: we must not set 'class' to be a keyword to avoid problems
    # with older uses.
    $is_package{'class'} = $use_feature_class;

    # 'method' - treated like sub using the sub-alias-list option
    # Note: we must not set 'method' to be a keyword to avoid problems
    # with older uses.
    if ($use_feature_class) {
        $is_sub{'method'}                 = 1;
        $is_END_DATA_format_sub{'method'} = 1;
    }

    # 'field'  - added as a keyword, and works like 'my'
    # Setting zero_continuation_block_type allows inclusion in table of level
    # differences in case of a missing or extra brace (see sub wrapup).
    $is_keyword{'field'}                      = $use_feature_class;
    $is_my_our_state{'field'}                 = $use_feature_class;
    $is_zero_continuation_block_type{'field'} = $use_feature_class;

    # 'ADJUST' - added as a keyword and works like 'BEGIN'
    # See update git #182 for 'ADJUST :params'
    # Setting zero_continuation_block_type allows inclusion in table of level
    # differences in case of a missing or extra brace (see sub wrapup).
    $is_keyword{'ADJUST'}                      = $use_feature_class;
    $is_code_block_token{'ADJUST'}             = $use_feature_class;
    $is_zero_continuation_block_type{'ADJUST'} = $use_feature_class;

    %is_grep_alias = ();
    if ( $rOpts->{'grep-alias-list'} ) {

        # Note that 'grep-alias-list' has been preprocessed to be a trimmed,
        # space-separated list
        my @q = split /\s+/, $rOpts->{'grep-alias-list'};
        $is_grep_alias{$_} = 1 for @q;
    }

    $rOpts_starting_indentation_level = $rOpts->{'starting-indentation-level'};
    $rOpts_indent_columns             = $rOpts->{'indent-columns'};
    $rOpts_look_for_hash_bang         = $rOpts->{'look-for-hash-bang'};
    $rOpts_look_for_autoloader        = $rOpts->{'look-for-autoloader'};
    $rOpts_look_for_selfloader        = $rOpts->{'look-for-selfloader'};
    $rOpts_trim_qw                    = $rOpts->{'trim-qw'};
    $rOpts_extended_syntax            = $rOpts->{'extended-syntax'};
    $rOpts_continuation_indentation   = $rOpts->{'continuation-indentation'};
    $rOpts_outdent_labels             = $rOpts->{'outdent-labels'};
    $rOpts_maximum_level_errors       = $rOpts->{'maximum-level-errors'};
    $rOpts_maximum_unexpected_errors  = $rOpts->{'maximum-unexpected-errors'};
    $rOpts_code_skipping              = $rOpts->{'code-skipping'};
    $rOpts_code_skipping_begin        = $rOpts->{'code-skipping-begin'};
    $rOpts_format_skipping            = $rOpts->{'format-skipping'};
    $rOpts_format_skipping_begin      = $rOpts->{'format-skipping-begin'};
    $rOpts_format_skipping_end        = $rOpts->{'format-skipping-end'};
    $rOpts_indent_closing_brace       = $rOpts->{'indent-closing-brace'};
    $rOpts_non_indenting_braces       = $rOpts->{'non-indenting-braces'};
    $rOpts_non_indenting_brace_prefix = $rOpts->{'non-indenting-brace-prefix'};
    $rOpts_whitespace_cycle           = $rOpts->{'whitespace-cycle'};

    # In the Tokenizer, --indent-columns is just used for guessing old
    # indentation, and must be positive.  If -i=0 is used for this run (which
    # is possible) we'll just guess that the old run used 4 spaces per level.
    if ( !$rOpts_indent_columns ) {
        $rOpts_indent_columns = INDENT_COLUMNS_DEFAULT;
    }

    # Define $tabsize, the number of spaces per tab for use in
    # guessing the indentation of source lines with leading tabs.
    # Assume same as for this run if tabs are used, otherwise assume
    # a default value, typically 8
    $tabsize =
        $rOpts->{'entab-leading-whitespace'}
      ? $rOpts->{'entab-leading-whitespace'}
      : $rOpts->{'tabs'} ? $rOpts->{'indent-columns'}
      :                    $rOpts->{'default-tabsize'};
    if ( !$tabsize ) { $tabsize = TAB_SIZE_DEFAULT }

    $code_skipping_pattern_begin =
      make_skipping_pattern( $rOpts, 'code-skipping-begin', '#<<V' );
    $code_skipping_pattern_end =
      make_skipping_pattern( $rOpts, 'code-skipping-end', '#>>V' );

    $format_skipping_pattern_begin =
      make_skipping_pattern( $rOpts, 'format-skipping-begin', '#<<<' );
    $format_skipping_pattern_end =
      make_skipping_pattern( $rOpts, 'format-skipping-end', '#>>>' );

    return;
} ## end sub check_options

sub new {

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

    my %defaults = (
        source_object        => undef,
        debugger_object      => undef,
        diagnostics_object   => undef,
        logger_object        => undef,
        starting_level       => undef,
        starting_line_number => 1,
        rOpts                => {},
    );
    my %args = ( %defaults, @arglist );

    # we are given an object with a get_line() method to supply source lines
    my $source_object = $args{source_object};
    my $rOpts         = $args{rOpts};

    # Check call args
    if ( !defined($source_object) ) {
        Die(
"Perl::Tidy::Tokenizer::new called without a 'source_object' parameter\n"
        );
    }
    if ( !ref($source_object) ) {
        Die(<<EOM);
sub Perl::Tidy::Tokenizer::new received a 'source_object' parameter which is not a reference;
'source_object' must be a reference to a STRING, ARRAY, or object with a 'getline' method
EOM
    }

    my $logger_object = $args{logger_object};

    # Tokenizer state data is as follows:
    # _rhere_target_list_    reference to list of here-doc targets
    # _here_doc_target_      the target string for a here document
    # _here_quote_character_ the type of here-doc quoting (" ' ` or none)
    #                        to determine if interpolation is done
    # _quote_target_         character we seek if chasing a quote
    # _line_start_quote_     line where we started looking for a long quote
    # _in_here_doc_          flag indicating if we are in a here-doc
    # _in_pod_               flag set if we are in pod documentation
    # _in_code_skipping_     flag set if we are in a code skipping section
    # _in_format_skipping_   flag set if we are in a format skipping section
    # _in_error_             flag set if we saw severe error (binary in script)
    # _do_not_format_        flag set if formatting should be skipped
    # _warning_count_        number of calls to logger sub warning
    # _html_tag_count_       number of apparent html tags seen (indicates html)
    # _in_data_              flag set if we are in __DATA__ section
    # _in_end_               flag set if we are in __END__ section
    # _in_format_            flag set if we are in a format description
    # _in_attribute_list_    flag telling if we are looking for attributes
    # _in_quote_             flag telling if we are chasing a quote
    # _starting_level_       indentation level of first line
    # _diagnostics_object_   place to write debugging information
    # _unexpected_error_count_ error count used to limit output
    # _lower_case_labels_at_ line numbers where lower case labels seen
    # _hit_bug_              program bug detected

    my $self = [];
    $self->[_rhere_target_list_]    = [];
    $self->[_in_here_doc_]          = 0;
    $self->[_here_doc_target_]      = EMPTY_STRING;
    $self->[_here_quote_character_] = EMPTY_STRING;
    $self->[_in_data_]              = 0;
    $self->[_in_end_]               = 0;
    $self->[_in_format_]            = 0;
    $self->[_in_error_]             = 0;
    $self->[_do_not_format_]        = 0;
    $self->[_warning_count_]        = 0;
    $self->[_html_tag_count_]       = 0;
    $self->[_in_pod_]               = 0;
    $self->[_in_code_skipping_] =
      $rOpts->{'code-skipping-from-start'} && $rOpts_code_skipping;
    $self->[_in_format_skipping_]       = 0;
    $self->[_rformat_skipping_list_]    = [];
    $self->[_in_attribute_list_]        = 0;
    $self->[_in_quote_]                 = 0;
    $self->[_quote_target_]             = EMPTY_STRING;
    $self->[_line_start_quote_]         = -1;
    $self->[_starting_level_]           = $args{starting_level};
    $self->[_know_starting_level_]      = defined( $args{starting_level} );
    $self->[_last_line_number_]         = $args{starting_line_number} - 1;
    $self->[_saw_perl_dash_P_]          = 0;
    $self->[_saw_perl_dash_w_]          = 0;
    $self->[_saw_use_strict_]           = 0;
    $self->[_saw_brace_error_]          = 0;
    $self->[_hit_bug_]                  = 0;
    $self->[_look_for_autoloader_]      = $rOpts_look_for_autoloader;
    $self->[_look_for_selfloader_]      = $rOpts_look_for_selfloader;
    $self->[_saw_autoloader_]           = 0;
    $self->[_saw_selfloader_]           = 0;
    $self->[_saw_hash_bang_]            = 0;
    $self->[_saw_end_]                  = 0;
    $self->[_saw_data_]                 = 0;
    $self->[_saw_negative_indentation_] = 0;
    $self->[_started_tokenizing_]       = 0;
    $self->[_debugger_object_]          = $args{debugger_object};
    $self->[_diagnostics_object_]       = $args{diagnostics_object};
    $self->[_logger_object_]            = $logger_object;
    $self->[_unexpected_error_count_]   = 0;
    $self->[_started_looking_for_here_target_at_] = 0;
    $self->[_nearly_matched_here_target_at_]      = undef;
    $self->[_line_of_text_]                       = EMPTY_STRING;
    $self->[_rlower_case_labels_at_]              = undef;
    $self->[_maximum_level_]                      = 0;
    $self->[_true_brace_error_count_]             = 0;
    $self->[_rnon_indenting_brace_stack_]         = [];
    $self->[_rseqno_at_depth_]                    = [SEQ_ROOT];
    $self->[_show_indentation_table_]             = 0;
    $self->[_rbareword_info_]                     = {};
    $self->[_rsaw_unknown_syntax_in_seqno_]       = {};

    $self->[_rclosing_brace_indentation_hash_] = {
        valid                 => undef,
        rhistory_line_number  => [0],
        rhistory_level_diff   => [0],
        rhistory_anchor_point => [1],
    };

    $self->[_rOpts_] = $rOpts;
    $self->[_save_logfile_] =
      defined($logger_object) && $logger_object->get_save_logfile();

    bless $self, $class;

    $self->prepare_for_a_new_file($source_object);
    $self->find_starting_indentation_level();

    # This is not a full class yet, so die if an attempt is made to
    # create more than one object.

    if ( _increment_count() > 1 ) {
        confess
"Attempt to create more than 1 object in $class, which is not a true class yet\n";
    }

    return $self;

} ## end sub new

# Called externally
sub get_unexpected_error_count {
    my ($self) = @_;
    return $self->[_unexpected_error_count_];
}

# Called externally
sub is_keyword {
    my ($str) = @_;
    return $is_keyword{$str};
}

#----------------------------------------------------------------
# Line input routines, previously handled by the LineBuffer class
#----------------------------------------------------------------
sub make_source_array {

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

    # Convert the source into an array of lines
    # Given:
    #   $line_source_object = the input source stream
    # Task:
    #   Convert the source to an array ref and store in $self

    my $rinput_lines = [];

    my $rsource = ref($line_source_object);
    my $source_string;

    if ( !$rsource ) {

        # shouldn't happen: this should have been checked in sub new
        Fault(<<EOM);
sub Perl::Tidy::Tokenizer::new received a 'source_object' parameter which is not a reference;
'source_object' must be a reference to a STRING, ARRAY, or object with a 'getline' method
EOM
    }

    # handle an ARRAY ref
    elsif ( $rsource eq 'ARRAY' ) {
        $rinput_lines  = $line_source_object;
        $source_string = join( EMPTY_STRING, @{$line_source_object} );
    }

    # handle a SCALAR ref
    elsif ( $rsource eq 'SCALAR' ) {
        $source_string = ${$line_source_object};
        my @lines = split /^/, $source_string;
        $rinput_lines = \@lines;
    }

    # handle an object - must have a get_line method
    else {

        # This will die if user's object does have a 'get_line' method
        my $line;
        while ( defined( $line = $line_source_object->get_line() ) ) {
            push( @{$rinput_lines}, $line );
        }
        $source_string = join( EMPTY_STRING, @{$rinput_lines} );
    }

    # Get trimmed lines. It is much faster to strip leading whitespace from
    # the whole input file at once than line-by-line.

    # Add a terminal newline if needed to keep line count unchanged:
    # - avoids problem of losing a last line which is just \r and no \n  (c283)
    # - but check input line count to avoid adding line to an empty file (c286)
    if ( @{$rinput_lines} && $source_string !~ /\n$/ ) {
        $source_string .= "\n";
    }

    # Remove leading whitespace except newlines
    $source_string =~ s/^ [^\S\n]+ //gxm;

    # Then break the string into lines
    my @trimmed_lines = split /^/, $source_string;

    # Safety check - a change in number of lines would be a disaster
    if ( @trimmed_lines != @{$rinput_lines} ) {

        # Shouldn't happen - die in DEVEL_MODE and fix
        my $ntr = @trimmed_lines;
        my $utr = @{$rinput_lines};
        DEVEL_MODE
          && Fault("trimmed / untrimmed line counts differ: $ntr / $utr\n");

        # Otherwise we can safely continue with undefined trimmed lines.  They
        # will be detected and fixed later.
        @trimmed_lines = ();
    }

    $self->[_rinput_lines_]          = $rinput_lines;
    $self->[_rtrimmed_input_lines_]  = \@trimmed_lines;
    $self->[_input_line_index_next_] = 0;
    return;
} ## end sub make_source_array

sub peek_ahead {
    my ( $self, $buffer_index ) = @_;

    # look $buffer_index lines ahead of the current location in the input
    # stream without disturbing the input
    my $line;
    my $rinput_lines = $self->[_rinput_lines_];
    my $line_index   = $buffer_index + $self->[_input_line_index_next_];
    if ( $line_index < @{$rinput_lines} ) {
        $line = $rinput_lines->[$line_index];
    }
    return $line;
} ## end sub peek_ahead

#-----------------------------------------
# interface to Perl::Tidy::Logger routines
#-----------------------------------------
sub warning {

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

    my $logger_object = $self->[_logger_object_];
    $self->[_warning_count_]++;
    if ($logger_object) {
        my $msg_line_number = $self->[_last_line_number_];
        $logger_object->warning( $msg, $msg_line_number );
    }
    return;
} ## end sub warning

sub warning_do_not_format {
    my ( $self, $msg ) = @_;

    # Issue a warning message and set a flag to skip formatting this file.
    $self->warning($msg);
    $self->[_do_not_format_] = 1;
    return;
} ## end sub warning_do_not_format

sub complain {

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

    my $logger_object = $self->[_logger_object_];
    if ($logger_object) {
        my $input_line_number = $self->[_last_line_number_];
        $logger_object->complain( $msg, $input_line_number );
    }
    return;
} ## end sub complain

sub write_logfile_entry {

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

    my $logger_object = $self->[_logger_object_];
    if ($logger_object) {
        $logger_object->write_logfile_entry($msg);
    }
    return;
} ## end sub write_logfile_entry

sub interrupt_logfile {

    my $self = shift;

    my $logger_object = $self->[_logger_object_];
    if ($logger_object) {
        $logger_object->interrupt_logfile();
    }
    return;
} ## end sub interrupt_logfile

sub resume_logfile {

    my $self = shift;

    my $logger_object = $self->[_logger_object_];
    if ($logger_object) {
        $logger_object->resume_logfile();
    }
    return;
} ## end sub resume_logfile

sub brace_warning {
    my ( $self, $msg ) = @_;
    $self->[_saw_brace_error_]++;

    my $logger_object = $self->[_logger_object_];
    if ($logger_object) {
        my $msg_line_number = $self->[_last_line_number_];
        $logger_object->brace_warning( $msg, $msg_line_number );
    }
    return;
} ## end sub brace_warning

sub increment_brace_error {

    # This is same as sub brace_warning but without a message
    my $self = shift;
    $self->[_saw_brace_error_]++;

    my $logger_object = $self->[_logger_object_];
    if ($logger_object) {
        $logger_object->increment_brace_error();
    }
    return;
} ## end sub increment_brace_error

sub get_saw_brace_error {
    my $self = shift;
    return $self->[_saw_brace_error_];
}

sub report_definite_bug {
    my $self = shift;
    $self->[_hit_bug_] = 1;
    my $logger_object = $self->[_logger_object_];
    if ($logger_object) {
        $logger_object->report_definite_bug();
    }
    return;
} ## end sub report_definite_bug

#-------------------------------------
# Interface to Perl::Tidy::Diagnostics
#-------------------------------------
sub write_diagnostics {
    my ( $self, $msg ) = @_;
    my $input_line_number  = $self->[_last_line_number_];
    my $diagnostics_object = $self->[_diagnostics_object_];
    if ($diagnostics_object) {
        $diagnostics_object->write_diagnostics( $msg, $input_line_number );
    }
    return;
} ## end sub write_diagnostics

sub report_tokenization_errors {

    my ($self) = @_;

    # Report any tokenization errors and return a flag '$severe_error'.
    # Set $severe_error = 1 if the tokenization errors are so severe that
    # the formatter should not attempt to format the file. Instead, it will
    # just output the file verbatim.

    # set severe error flag if tokenizer has encountered file reading problems
    # (i.e. unexpected binary characters)
    # or code which may not be formatted correctly (such as 'my sub q')
    # The difference between _in_error_ and _do_not_format_ is that
    # _in_error_ stops the tokenizer immediately whereas
    # _do_not_format_ lets the tokenizer finish so that all errors are seen
    # Both block formatting and cause the input stream to be output verbatim.
    my $severe_error = $self->[_in_error_] || $self->[_do_not_format_];

    # And do not format if it looks like an html file (c209)
    $severe_error ||= $self->[_html_tag_count_] && $self->[_warning_count_];

    # Inform the logger object on length of input stream
    my $logger_object = $self->[_logger_object_];
    if ($logger_object) {
        my $last_line_number = $self->[_last_line_number_];
        $logger_object->set_last_input_line_number($last_line_number);
    }

    my $maxle = $rOpts_maximum_level_errors;
    my $maxue = $rOpts_maximum_unexpected_errors;
    $maxle = 1 unless ( defined($maxle) );
    $maxue = 0 unless ( defined($maxue) );

    my $level = get_indentation_level();
    if ( $level != $self->[_starting_level_] ) {
        $self->warning("final indentation level: $level\n");

        $self->[_show_indentation_table_] = 1;

        my $level_diff = $self->[_starting_level_] - $level;
        if ( $level_diff < 0 ) { $level_diff = -$level_diff }

        # Set severe error flag if the level error is greater than 1.
        # The formatter can function for any level error but it is probably
        # best not to attempt formatting for a high level error.
        if ( $maxle >= 0 && $level_diff > $maxle ) {
            $severe_error = 1;
            $self->warning(<<EOM);
Formatting will be skipped because level error '$level_diff' exceeds -maxle=$maxle; use -maxle=-1 to force formatting
EOM
        }
    }

    $self->check_final_nesting_depths();

    if ( $self->[_show_indentation_table_] ) {
        $self->show_indentation_table();
    }

    # Likewise, large numbers of brace errors usually indicate non-perl
    # scripts, so set the severe error flag at a low number.  This is similar
    # to the level check, but different because braces may balance but be
    # incorrectly interlaced.
    if ( $self->[_true_brace_error_count_] > 2 ) {
        $severe_error = 1;
    }

    if ( $rOpts_look_for_hash_bang
        && !$self->[_saw_hash_bang_] )
    {
        $self->warning(
            "hit EOF without seeing hash-bang line; maybe don't need -x?\n");
    }

    if ( $self->[_in_format_] ) {
        $self->warning("hit EOF while in format description\n");
    }

    if ( $self->[_in_code_skipping_] ) {
        $self->write_logfile_entry(
            "hit EOF while in lines skipped with --code-skipping\n");
    }

    if ( $self->[_in_pod_] ) {

        # Just write log entry if this is after __END__ or __DATA__
        # because this happens to often, and it is not likely to be
        # a parsing error.
        if ( $self->[_saw_data_] || $self->[_saw_end_] ) {
            $self->write_logfile_entry(
"hit eof while in pod documentation (no =cut seen)\n\tthis can cause trouble with some pod utilities\n"
            );
        }

        else {
            $self->complain(
"hit eof while in pod documentation (no =cut seen)\n\tthis can cause trouble with some pod utilities\n"
            );
        }

    }

    if ( $self->[_in_here_doc_] ) {
        $severe_error = 1;
        my $here_doc_target = $self->[_here_doc_target_];
        my $started_looking_for_here_target_at =
          $self->[_started_looking_for_here_target_at_];
        if ($here_doc_target) {
            $self->warning(
"hit EOF in here document starting at line $started_looking_for_here_target_at with target: $here_doc_target\n"
            );
        }
        else {
            $self->warning(<<EOM);
Hit EOF in here document starting at line $started_looking_for_here_target_at with empty target string.
  (Perl will match to the end of file but this may not be intended).
EOM
        }
        my $nearly_matched_here_target_at =
          $self->[_nearly_matched_here_target_at_];
        if ($nearly_matched_here_target_at) {
            $self->warning(
"NOTE: almost matched at input line $nearly_matched_here_target_at except for whitespace\n"
            );
        }
    }

    # Something is seriously wrong if we ended inside a quote
    if ( $self->[_in_quote_] ) {
        $severe_error = 1;
        my $line_start_quote = $self->[_line_start_quote_];
        my $quote_target     = $self->[_quote_target_];
        my $what =
          ( $self->[_in_attribute_list_] )
          ? "attribute list"
          : "quote/pattern";
        $self->warning(
"hit EOF seeking end of $what starting at line $line_start_quote ending in $quote_target\n"
        );
    }

    if ( $self->[_hit_bug_] ) {
        $severe_error = 1;
    }

    # Multiple "unexpected" type tokenization errors usually indicate parsing
    # non-perl scripts, or that something is seriously wrong, so we should
    # avoid formatting them.  This can happen for example if we run perltidy on
    # a shell script or an html file.  But unfortunately this check can
    # interfere with some extended syntaxes, such as RPerl, so it has to be off
    # by default.
    my $ue_count = $self->[_unexpected_error_count_];
    if ( $maxue > 0 && $ue_count > $maxue ) {
        $self->warning(<<EOM);
Formatting will be skipped since unexpected token count = $ue_count > -maxue=$maxue; use -maxue=0 to force formatting
EOM
        $severe_error = 1;
    }

    if ( !$self->[_saw_perl_dash_w_] ) {
        $self->write_logfile_entry("Suggest including 'use warnings;'\n");
    }

    if ( $self->[_saw_perl_dash_P_] ) {
        $self->write_logfile_entry(
            "Use of -P parameter for defines is discouraged\n");
    }

    if ( !$self->[_saw_use_strict_] ) {
        $self->write_logfile_entry("Suggest including 'use strict;'\n");
    }

    # it is suggested that labels have at least one upper case character
    # for legibility and to avoid code breakage as new keywords are introduced
    if ( $self->[_rlower_case_labels_at_] ) {
        my @lower_case_labels_at = @{ $self->[_rlower_case_labels_at_] };
        $self->write_logfile_entry(
            "Suggest using upper case characters in label(s)\n");
        local $LIST_SEPARATOR = ')(';
        $self->write_logfile_entry(
            "  defined at line(s): (@lower_case_labels_at)\n");
    }

    # Get the text of any leading format skipping tag
    my $early_FS_end_marker;
    my $rformat_skipping_list = $self->[_rformat_skipping_list_];
    if ( @{$rformat_skipping_list} && $rformat_skipping_list->[0]->[0] == -1 ) {
        $early_FS_end_marker = $rformat_skipping_list->[0]->[2];
    }

    return {
        severe_error        => $severe_error,
        early_FS_end_marker => $early_FS_end_marker,
    };

} ## end sub report_tokenization_errors

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

    # Output indentation table made at closing braces.  This can be helpful for
    # the case of a missing brace in a previously formatted file.

    # skip if problem reading file
    return if ( $self->[_in_error_] );

    # skip if -wc is used (rare); it is too complex to use
    return if ($rOpts_whitespace_cycle);

    # skip if non-indenting-brace-prefix (very rare, but could be fixed)
    return if ($rOpts_non_indenting_brace_prefix);

    # skip if starting level is not zero (probably in editor)
    return if ($rOpts_starting_indentation_level);

    # skip if indentation analysis is not valid
    my $rhash = $self->[_rclosing_brace_indentation_hash_];
    return if ( !$rhash->{valid} );

    my $rhistory_line_number  = $rhash->{rhistory_line_number};
    my $rhistory_level_diff   = $rhash->{rhistory_level_diff};
    my $rhistory_anchor_point = $rhash->{rhistory_anchor_point};

    # Remove the first artificial point from the table
    shift @{$rhistory_line_number};
    shift @{$rhistory_level_diff};
    shift @{$rhistory_anchor_point};

    # Remove dubious points at an anchor point = 2 and beyond
    # These can occur when non-indenting braces are used
    my $num_his = @{$rhistory_level_diff};
    foreach my $i ( 0 .. $num_his - 1 ) {
        if ( $rhistory_anchor_point->[$i] == 2 ) {
            $num_his = $i;
            last;
        }
    }
    return if ( $num_his <= 1 );

    # Ignore an ending non-anchor point
    if ( !$rhistory_anchor_point->[-1] ) {
        $num_his -= 1;
    }

    # Ignore an ending point which is the same as the previous point
    if ( $num_his > 1 ) {
        if ( $rhistory_level_diff->[ $num_his - 1 ] ==
            $rhistory_level_diff->[ $num_his - 2 ] )
        {
            $num_his -= 1;
        }
    }

    # Skip if the table does not have at least 2 points to pinpoint an error
    return if ( $num_his <= 1 );

    # Skip if first point shows a level error - the analysis may not be valid
    return if ( $rhistory_level_diff->[0] );

    # Remove table points which return from negative to zero; they follow
    # an error and may not be correct. c448.
    my $min_lev = $rhistory_level_diff->[0];
    foreach my $ii ( 1 .. $num_his - 1 ) {
        my $lev = $rhistory_level_diff->[$ii];
        if ( $lev < $min_lev ) { $min_lev = $lev; next }
        if ( $min_lev < 0 && $lev >= 0 ) {
            $num_his = $ii;
            last;
        }
    }

    # Since the table could be arbitrarily large, we will limit the table to N
    # lines.  If there are more lines than that, we will show N-3 lines, then
    # ..., then the last 2 lines. Allow about 3 lines per error, so a table
    # limit of 10 can localize up to about 3 errors in a file.
    my $nlines_max   = 10;
    my @pre_indexes  = ( 0 .. $num_his - 1 );
    my @post_indexes = ();
    if ( @pre_indexes > $nlines_max ) {
        if ( $nlines_max >= 5 ) {
            @pre_indexes  = ( 0 .. $nlines_max - 4 );
            @post_indexes = ( $num_his - 2, $num_his - 1 );
        }
        else {
            @pre_indexes = ( 0 .. $nlines_max - 1 );
        }
    }

    my @output_lines;
    push @output_lines, <<EOM;
Table of initial nesting level differences at closing braces.
This might help localize brace errors IF perltidy previously formatted the file.
line: error=[new brace level]-[old indentation level]
EOM
    foreach my $i (@pre_indexes) {
        my $lno  = $rhistory_line_number->[$i];
        my $diff = $rhistory_level_diff->[$i];
        push @output_lines, <<EOM;
$lno: $diff
EOM
    }
    if (@post_indexes) {
        push @output_lines, "...\n";
        foreach my $i (@post_indexes) {
            my $lno  = $rhistory_line_number->[$i];
            my $diff = $rhistory_level_diff->[$i];
            push @output_lines, <<EOM;
$lno: $diff
EOM
        }
    }

    # Try to give a hint
    my $level_diff_1 = $rhistory_level_diff->[1];
    my $ln_0         = $rhistory_line_number->[0];
    my $ln_1         = $rhistory_line_number->[1];
    if ( $level_diff_1 < 0 ) {
        push @output_lines,
"There may be an extra '}' or missing '{' between lines $ln_0 and $ln_1\n";
    }
    elsif ( $level_diff_1 > 0 ) {
        push @output_lines,
"There may be a missing '}' or extra '{' between lines $ln_0 and $ln_1\n";
    }
    else {
        ## two leading zeros in the table - probably can't happen - no hint
    }

    push @output_lines, "\n";
    my $output_str = join EMPTY_STRING, @output_lines;

    $self->interrupt_logfile();
    $self->warning($output_str);
    $self->resume_logfile();

    return;
} ## end sub show_indentation_table

sub report_v_string {

    # warn if this version can't handle v-strings
    my ( $self, $tok ) = @_;
    if ( $] < 5.006 ) {
        $self->warning(
"Found v-string '$tok' but v-strings are not implemented in your version of perl; see Camel 3 book ch 2\n"
        );
    }
    return;
} ## end sub report_v_string

sub is_valid_token_type {
    my ($type) = @_;
    return $is_valid_token_type{$type};
}

sub log_numbered_msg {
    my ( $self, $msg ) = @_;

    # write input line number + message to logfile
    my $input_line_number = $self->[_last_line_number_];
    $self->write_logfile_entry("Line $input_line_number: $msg");
    return;
} ## end sub log_numbered_msg

sub get_line {

    my $self = shift;

    # Read the next input line and tokenize it
    # Returns:
    #   $line_of_tokens = ref to hash of info for the tokenized line

    # USES GLOBAL VARIABLES:
    #   $brace_depth, $square_bracket_depth, $paren_depth

    # get the next line from the input array
    my $input_line;
    my $trimmed_input_line;
    my $line_index   = $self->[_input_line_index_next_];
    my $rinput_lines = $self->[_rinput_lines_];
    if ( $line_index < @{$rinput_lines} ) {
        $trimmed_input_line = $self->[_rtrimmed_input_lines_]->[$line_index];
        $input_line         = $rinput_lines->[ $line_index++ ];
        $self->[_input_line_index_next_] = $line_index;
    }

    # End of file .. check if file ends in a binary operator (c565)
    else {
        if (
            $is_binary_or_unary_operator_type{$last_nonblank_type}
            || (   $last_nonblank_type eq 'k'
                && $is_binary_or_unary_keyword{$last_nonblank_token} )
          )
        {
            $self->warning(
                "Unexpected EOF at operator '$last_nonblank_token'\n");

            # avoid repeating this message
            $last_nonblank_token = ';';
            $last_nonblank_type  = ';';
        }
    }

    $self->[_line_of_text_] = $input_line;

    return if ( !defined($input_line) );

    my $input_line_number = ++$self->[_last_line_number_];

    # Find and remove what characters terminate this line, including any
    # control r
    my $input_line_separator = EMPTY_STRING;
    if ( chomp $input_line ) {
        $input_line_separator = $INPUT_RECORD_SEPARATOR;
    }

    # The first test here very significantly speeds things up, but be sure to
    # keep the regex and hash %other_line_endings the same.
    if ( $other_line_endings{ substr( $input_line, -1 ) } ) {
        if ( $input_line =~ s/([\r\035\032])+$// ) {
            $input_line_separator = $1 . $input_line_separator;

            # This could make the trimmed input line incorrect, so the
            # safe thing to do is to make it undef to force it to be
            # recomputed later.
            $trimmed_input_line = undef;
        }
    }

    # For backwards compatibility we keep the line text terminated with
    # a newline character
    $input_line .= "\n";
    $self->[_line_of_text_] = $input_line;

    # create a data structure describing this line which will be
    # returned to the caller.

    # _line_type codes are:
    #   SYSTEM         - system-specific code before hash-bang line
    #   CODE           - line of perl code (including comments)
    #   POD_START      - line starting pod, such as '=head'
    #   POD            - pod documentation text
    #   POD_END        - last line of pod section, '=cut'
    #   HERE           - text of here-document
    #   HERE_END       - last line of here-doc (target word)
    #   FORMAT         - format section
    #   FORMAT_END     - last line of format section, '.'
    #   SKIP           - code skipping section
    #   SKIP_END       - last line of code skipping section, '#>>V'
    #   DATA_START     - __DATA__ line
    #   DATA           - unidentified text following __DATA__
    #   END_START      - __END__ line
    #   END            - unidentified text following __END__
    #   ERROR          - we are in big trouble, probably not a perl script

    # Other variables:
    #   _curly_brace_depth     - depth of curly braces at start of line
    #   _square_bracket_depth  - depth of square brackets at start of line
    #   _paren_depth           - depth of parens at start of line
    #   _starting_in_quote     - this line continues a multi-line quote
    #                            (so don't trim leading blanks!)
    #   _ending_in_quote       - this line ends in a multi-line quote
    #                            (so don't trim trailing blanks!)
    my $line_of_tokens = {
        _line_type                 => 'EOF',
        _line_text                 => $input_line,
        _line_number               => $input_line_number,
        _guessed_indentation_level => 0,
        _curly_brace_depth         => $brace_depth,
        _square_bracket_depth      => $square_bracket_depth,
        _paren_depth               => $paren_depth,
## Skip these needless initializations for efficiency:
##      _rtoken_type               => undef,
##      _rtokens                   => undef,
##      _rlevels                   => undef,
##      _rblock_type               => undef,
##      _rtype_sequence            => undef,
##      _starting_in_quote         => 0,
##      _ending_in_quote           => 0,
    };

    # Must print line unchanged if we are in a here document
    if ( $self->[_in_here_doc_] ) {

        $line_of_tokens->{_line_type} = 'HERE';
        my $here_doc_target      = $self->[_here_doc_target_];
        my $here_quote_character = $self->[_here_quote_character_];
        my $candidate_target     = $input_line;
        my $leading_whitespace   = EMPTY_STRING;
        chomp $candidate_target;

        # Handle <<~ targets, which are indicated here by a leading space on
        # the here quote character. c603 has test cases.
        # the leading whitespace of all here text lines match it.
        my $ix = rindex( $candidate_target, $here_doc_target );
        if ( $ix > 0 && $here_quote_character =~ /^\s/ ) {
            $leading_whitespace = substr( $candidate_target, 0, $ix );
            if ( $leading_whitespace !~ /^\s*$/ ) {
                $leading_whitespace = EMPTY_STRING;
            }
        }

        if ( $candidate_target eq $leading_whitespace . $here_doc_target ) {
            $self->[_nearly_matched_here_target_at_] = undef;
            $line_of_tokens->{_line_type} = 'HERE_END';
            $self->log_numbered_msg("Exiting HERE document $here_doc_target\n");

            my $rhere_target_list = $self->[_rhere_target_list_];
            if ( @{$rhere_target_list} ) {  # there can be multiple here targets
                ( $here_doc_target, $here_quote_character ) =
                  @{ shift @{$rhere_target_list} };
                $self->[_here_doc_target_]      = $here_doc_target;
                $self->[_here_quote_character_] = $here_quote_character;
                $self->log_numbered_msg(
                    "Entering HERE document $here_doc_target\n");
                $self->[_nearly_matched_here_target_at_] = undef;
                $self->[_started_looking_for_here_target_at_] =
                  $input_line_number;
            }
            else {
                $self->[_in_here_doc_]          = 0;
                $self->[_here_doc_target_]      = EMPTY_STRING;
                $self->[_here_quote_character_] = EMPTY_STRING;
            }
        }

        # check for error of extra whitespace
        # note for PERL6: leading whitespace is allowed
        else {
            $candidate_target =~ s/^ \s+ | \s+ $//gx;    # trim both ends
            if ( $candidate_target eq $here_doc_target ) {
                $self->[_nearly_matched_here_target_at_] = $input_line_number;
            }
        }
        return $line_of_tokens;
    }

    # Print line unchanged if we are in a format section
    elsif ( $self->[_in_format_] ) {

        if ( $input_line =~ /^\.[\s#]*$/ ) {

            # Decrement format depth count at a '.' after a 'format'
            $self->[_in_format_]--;

            # This is the end when count reaches 0
            if ( !$self->[_in_format_] ) {
                $self->log_numbered_msg("Exiting format section\n");
                $line_of_tokens->{_line_type} = 'FORMAT_END';

                # Make the tokenizer mark an opening brace which follows
                # as a code block. Fixes issue c202/t032.
                $last_nonblank_token = ';';
                $last_nonblank_type  = ';';
            }
        }
        else {
            $line_of_tokens->{_line_type} = 'FORMAT';
            if ( $input_line =~ /^\s*format\s+\w+/ ) {

                # Increment format depth count at a 'format' within a 'format'
                # This is a simple way to handle nested formats (issue c019).
                $self->[_in_format_]++;
            }
        }
        return $line_of_tokens;
    }

    # must print line unchanged if we are in pod documentation
    elsif ( $self->[_in_pod_] ) {

        $line_of_tokens->{_line_type} = 'POD';
        if ( $input_line =~ /^=cut/ ) {
            $line_of_tokens->{_line_type} = 'POD_END';
            $self->log_numbered_msg("Exiting POD section\n");
            $self->[_in_pod_] = 0;
        }
        if ( $input_line =~ /^\#\!.*perl\b/ && !$self->[_in_end_] ) {
            $self->warning(
                "Hash-bang in pod can cause older versions of perl to fail! \n"
            );
        }

        return $line_of_tokens;
    }

    # print line unchanged if in skipped section
    elsif ( $self->[_in_code_skipping_] ) {

        $line_of_tokens->{_line_type} = 'SKIP';
        if ( $input_line =~ /$code_skipping_pattern_end/ ) {
            $line_of_tokens->{_line_type} = 'SKIP_END';
            $self->log_numbered_msg("Exiting code-skipping section\n");
            $self->[_in_code_skipping_] = 0;
        }
        elsif ( $input_line =~ /$code_skipping_pattern_begin/ ) {

            # warn of duplicate starting comment lines, git #118
            my $lno = $self->[_in_code_skipping_];
            $self->warning(
                "Already in code-skipping section which started at line $lno\n"
            );
        }
        else {
            ## not a code-skipping control line
        }
        return $line_of_tokens;
    }

    # must print line unchanged if we have seen a severe error (i.e., we
    # are seeing illegal tokens and cannot continue.  Syntax errors do
    # not pass this route).  Calling routine can decide what to do, but
    # the default can be to just pass all lines as if they were after __END__
    elsif ( $self->[_in_error_] ) {
        $line_of_tokens->{_line_type} = 'ERROR';
        return $line_of_tokens;
    }

    # print line unchanged if we are __DATA__ section
    elsif ( $self->[_in_data_] ) {

        # ...but look for POD
        # Note that the _in_data and _in_end flags remain set
        # so that we return to that state after seeing the
        # end of a pod section
        if ( $input_line =~ /^=(\w+)\b/ && $1 ne 'cut' ) {
            $line_of_tokens->{_line_type} = 'POD_START';
            $self->log_numbered_msg("Entering POD section\n");
            $self->[_in_pod_] = 1;
            return $line_of_tokens;
        }
        else {
            $line_of_tokens->{_line_type} = 'DATA';
            return $line_of_tokens;
        }
    }

    # print line unchanged if we are in __END__ section
    elsif ( $self->[_in_end_] ) {

        # ...but look for POD
        # Note that the _in_data and _in_end flags remain set
        # so that we return to that state after seeing the
        # end of a pod section
        if ( $input_line =~ /^=(\w+)\b/ && $1 ne 'cut' ) {
            $line_of_tokens->{_line_type} = 'POD_START';
            $self->log_numbered_msg("Entering POD section\n");
            $self->[_in_pod_] = 1;
            return $line_of_tokens;
        }
        else {
            $line_of_tokens->{_line_type} = 'END';
            return $line_of_tokens;
        }
    }
    else {
        ## not a special control line
    }

    # check for a hash-bang line if we haven't seen one
    if (   !$self->[_saw_hash_bang_]
        && substr( $input_line, 0, 2 ) eq '#!'
        && $input_line =~ /^\#\!.*perl\b/ )
    {
        $self->[_saw_hash_bang_] = $input_line_number;

        # check for -w and -P flags
        if ( $input_line =~ /^\#\!.*perl\s.*-.*P/ ) {
            $self->[_saw_perl_dash_P_] = 1;
        }

        if ( $input_line =~ /^\#\!.*perl\s.*-.*w/ ) {
            $self->[_saw_perl_dash_w_] = 1;
        }

        if (
            $input_line_number > 1

            # leave any hash bang in a BEGIN block alone
            # i.e. see 'debugger-duck_type.t'
            && !(
                   $last_nonblank_block_type
                && $last_nonblank_block_type eq 'BEGIN'
            )
            && !$rOpts_look_for_hash_bang

            # Try to avoid giving a false alarm at a simple comment.
            # These look like valid hash-bang lines:

            #!/usr/bin/perl -w
            #!   /usr/bin/perl -w
            #!c:\perl\bin\perl.exe

            # These are comments:
            #! I love perl
            #!  sunos does not yet provide a /usr/bin/perl

            # Comments typically have multiple spaces, which suggests
            # the filter
            && $input_line =~ /^\#\!(\s+)?(\S+)?perl/
          )
        {

            # this is helpful for VMS systems; we may have accidentally
            # tokenized some DCL commands
            if ( $self->[_started_tokenizing_] ) {
                $self->warning(
"There seems to be a hash-bang after line 1; do you need to run with -x ?\n"
                );
            }
            else {
                $self->complain("Useless hash-bang after line 1\n");
            }
        }

        # Report the leading hash-bang as a system line
        # This will prevent -dac from deleting it
        else {
            $line_of_tokens->{_line_type} = 'SYSTEM';
            return $line_of_tokens;
        }
    }

    # wait for a hash-bang before parsing if the user invoked us with -x
    if ( $rOpts_look_for_hash_bang
        && !$self->[_saw_hash_bang_] )
    {
        $line_of_tokens->{_line_type} = 'SYSTEM';
        return $line_of_tokens;
    }

    # a first line of the form ': #' will be marked as SYSTEM
    # since lines of this form may be used by tcsh
    if ( $input_line_number == 1 && $input_line =~ /^\s*\:\s*\#/ ) {
        $line_of_tokens->{_line_type} = 'SYSTEM';
        return $line_of_tokens;
    }

    # now we know that it is ok to tokenize the line...
    # the line tokenizer will modify any of these private variables:
    #        _rhere_target_list_
    #        _in_data_
    #        _in_end_
    #        _in_format_
    #        _in_error_
    #        _in_code_skipping_
    #        _in_format_skipping_
    #        _in_pod_
    #        _in_quote_

    $self->tokenize_this_line( $line_of_tokens, $trimmed_input_line );

    # Now finish defining the return structure and return it
    $line_of_tokens->{_ending_in_quote} = $self->[_in_quote_];

    # handle severe error (binary data in script)
    if ( $self->[_in_error_] ) {
        $self->[_in_quote_] = 0;    # to avoid any more messages
        $self->warning("Giving up after error\n");
        $line_of_tokens->{_line_type} = 'ERROR';
        reset_indentation_level(0);    # avoid error messages
        return $line_of_tokens;
    }

    # handle start of pod documentation
    if ( $self->[_in_pod_] ) {

        # This gets tricky..above a __DATA__ or __END__ section, perl
        # accepts '=cut' as the start of pod section. But afterwards,
        # only pod utilities see it and they may ignore an =cut without
        # leading =head.  In any case, this isn't good.
        if ( $input_line =~ /^=cut\b/ ) {
            if ( $self->[_saw_data_] || $self->[_saw_end_] ) {
                $self->complain("=cut while not in pod ignored\n");
                $self->[_in_pod_] = 0;
                $line_of_tokens->{_line_type} = 'POD_END';
            }
            else {
                $line_of_tokens->{_line_type} = 'POD_START';
                if ( !DEVEL_MODE ) {
                    $self->warning(
"=cut starts a pod section .. this can fool pod utilities.\n"
                    );
                }
                $self->log_numbered_msg("Entering POD section\n");
            }
        }

        else {
            $line_of_tokens->{_line_type} = 'POD_START';
            $self->log_numbered_msg("Entering POD section\n");
        }

        return $line_of_tokens;
    }

    # handle start of skipped section
    if ( $self->[_in_code_skipping_] ) {

        $line_of_tokens->{_line_type} = 'SKIP';
        $self->log_numbered_msg("Entering code-skipping section\n");
        return $line_of_tokens;
    }

    # see if this line contains here doc targets
    my $rhere_target_list = $self->[_rhere_target_list_];
    if ( @{$rhere_target_list} ) {

        my ( $here_doc_target, $here_quote_character ) =
          @{ shift @{$rhere_target_list} };
        $self->[_in_here_doc_]          = 1;
        $self->[_here_doc_target_]      = $here_doc_target;
        $self->[_here_quote_character_] = $here_quote_character;
        $self->log_numbered_msg("Entering HERE document $here_doc_target\n");
        $self->[_started_looking_for_here_target_at_] = $input_line_number;
    }

    # NOTE: __END__ and __DATA__ statements are written unformatted
    # because they can theoretically contain additional characters
    # which are not tokenized (and cannot be read with <DATA> either!).
    if ( $self->[_in_data_] ) {
        $line_of_tokens->{_line_type} = 'DATA_START';
        $self->log_numbered_msg("Starting __DATA__ section\n");
        $self->[_saw_data_] = 1;

        # keep parsing after __DATA__ if use SelfLoader was seen
        if ( $self->[_saw_selfloader_] ) {
            $self->[_in_data_] = 0;
            $self->log_numbered_msg(
                "SelfLoader seen, continuing; -nlsl deactivates\n");
        }

        return $line_of_tokens;
    }

    elsif ( $self->[_in_end_] ) {
        $line_of_tokens->{_line_type} = 'END_START';
        $self->log_numbered_msg("Starting __END__ section\n");
        $self->[_saw_end_] = 1;

        # keep parsing after __END__ if use AutoLoader was seen
        if ( $self->[_saw_autoloader_] ) {
            $self->[_in_end_] = 0;
            $self->log_numbered_msg(
                "AutoLoader seen, continuing; -nlal deactivates\n");
        }
        return $line_of_tokens;
    }
    else {
        ## not in __END__ or __DATA__
    }

    # now, finally, we know that this line is type 'CODE'
    $line_of_tokens->{_line_type} = 'CODE';

    # remember if we have seen any real code
    if (  !$self->[_started_tokenizing_]
        && $input_line !~ /^\s*$/
        && $input_line !~ /^\s*#/ )
    {
        $self->[_started_tokenizing_] = 1;
    }

    if ( $self->[_debugger_object_] ) {
        $self->[_debugger_object_]->write_debug_entry($line_of_tokens);
    }

    # Note: if keyword 'format' occurs in this line code, it is still CODE
    # (keyword 'format' need not start a line)
    if ( $self->[_in_format_] ) {
        $self->log_numbered_msg("Entering format section\n");
    }

    if ( $self->[_in_quote_]
        and ( $self->[_line_start_quote_] < 0 ) )
    {
        if ( ( my $quote_target = $self->[_quote_target_] ) !~ /^\s*$/ ) {
            $self->[_line_start_quote_] = $input_line_number;
            $self->log_numbered_msg(
                "Start multi-line quote or pattern ending in $quote_target\n");
        }
    }
    elsif ( ( $self->[_line_start_quote_] >= 0 )
        && !$self->[_in_quote_] )
    {
        $self->[_line_start_quote_] = -1;
        $self->log_numbered_msg("End of multi-line quote or pattern\n");
    }
    else {
        ## not at the edge of a quote
    }

    # we are returning a line of CODE
    return $line_of_tokens;
} ## end sub get_line

sub find_starting_indentation_level {

    # We need to find the indentation level of the first line of the
    # script being formatted.  Often it will be zero for an entire file,
    # but if we are formatting a local block of code (within an editor for
    # example) it may not be zero.  The user may specify this with the
    # -sil=n parameter but normally doesn't so we have to guess.
    #
    my ($self) = @_;
    my $starting_level = 0;

    # use value if given as parameter
    if ( $self->[_know_starting_level_] ) {
        $starting_level = $self->[_starting_level_];
    }

    # if we know there is a hash_bang line, the level must be zero
    elsif ($rOpts_look_for_hash_bang) {
        $self->[_know_starting_level_] = 1;
    }

    # otherwise figure it out from the input file
    else {
        my $line;
        my $i = 0;

        # keep looking at lines until we find a hash bang or piece of code
        # ( or, for now, an =pod line)
        my $msg = EMPTY_STRING;
        my $in_code_skipping;
        my $line_for_guess;
        while ( defined( $line = $self->peek_ahead( $i++ ) ) ) {

            # if first line is #! then assume starting level is zero
            if ( $i == 1 && $line =~ /^\#\!/ ) {
                $starting_level = 0;
                last;
            }

            # ignore lines fenced off with code-skipping comments
            if ( $line =~ /^\s*#/ ) {

                # use first comment for indentation guess in case of no code
                if ( !defined($line_for_guess) ) { $line_for_guess = $line }

                if ( !$in_code_skipping ) {
                    if (   $rOpts_code_skipping
                        && $line =~ /$code_skipping_pattern_begin/ )
                    {
                        $in_code_skipping = 1;
                        next;
                    }
                }
                else {
                    if ( $line =~ /$code_skipping_pattern_end/ ) {
                        $in_code_skipping = 0;
                    }
                    next;
                }

                # Note that we could also ignore format-skipping lines here
                # but it isn't clear if that would be best.
                # See c326 for example code.

                next;
            }
            next if ($in_code_skipping);

            next if ( $line =~ /^\s*$/ );    # skip past blank lines

            # use first line of code for indentation guess
            $line_for_guess = $line;
            last;
        } ## end while ( defined( $line = ...))

        if ( defined($line_for_guess) ) {
            $starting_level =
              $self->guess_old_indentation_level($line_for_guess);
        }
        $msg = "Line $i implies starting-indentation-level = $starting_level\n";
        $self->write_logfile_entry("$msg");
    }
    $self->[_starting_level_] = $starting_level;
    reset_indentation_level($starting_level);
    return;
} ## end sub find_starting_indentation_level

sub guess_old_indentation_level {
    my ( $self, $line ) = @_;

    # Guess the indentation level of an input line.
    #
    # For the first line of code this result will define the starting
    # indentation level.  It will mainly be non-zero when perltidy is applied
    # within an editor to a local block of code.
    #
    # This is an impossible task in general because we can't know what tabs
    # meant for the old script and how many spaces were used for one
    # indentation level in the given input script.  For example it may have
    # been previously formatted with -i=7 -et=3.  But we can at least try to
    # make sure that perltidy guesses correctly if it is applied repeatedly to
    # a block of code within an editor, so that the block stays at the same
    # level when perltidy is applied repeatedly.
    #
    # USES GLOBAL VARIABLES: (none)
    my $level = 0;

    # find leading tabs, spaces, and any statement label
    my $spaces = 0;
    if ( $line =~ /^(\t+)?(\s+)?(\w+:[^:])?/ ) {

        # If there are leading tabs, we use the tab scheme for this run, if
        # any, so that the code will remain stable when editing.
        if ($1) { $spaces += length($1) * $tabsize }

        if ($2) { $spaces += length($2) }

        # correct for outdented labels
        if (   $3
            && $rOpts_outdent_labels
            && $rOpts_continuation_indentation > 0 )
        {
            $spaces += $rOpts_continuation_indentation;
        }
    }

    $level = int( $spaces / $rOpts_indent_columns );
    return ($level);
} ## end sub guess_old_indentation_level

sub dump_functions {

    # This is an unused debug routine, save for future use

    my $fh = *STDOUT;
    foreach my $pkg ( keys %{$ris_user_function} ) {
        $fh->print("\nnon-constant subs in package $pkg\n");

        foreach my $sub ( keys %{ $ris_user_function->{$pkg} } ) {
            my $msg = EMPTY_STRING;
            if ( $ris_block_list_function->{$pkg}->{$sub} ) {
                $msg = 'block_list';
            }

            if ( $ris_block_function->{$pkg}->{$sub} ) {
                $msg = 'block';
            }
            $fh->print("$sub $msg\n");
        }
    }

    foreach my $pkg ( keys %{$ris_constant} ) {
        $fh->print("\nconstants and constant subs in package $pkg\n");

        foreach my $sub ( keys %{ $ris_constant->{$pkg} } ) {
            $fh->print("$sub\n");
        }
    }
    return;
} ## end sub dump_functions

sub prepare_for_a_new_file {

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

    # copy the source object lines to an array of lines
    $self->make_source_array($source_object);

    # previous tokens needed to determine what to expect next
    $last_nonblank_token      = ';';    # the only possible starting state which
    $last_nonblank_type       = ';';    # will make a leading brace a code block
    $last_nonblank_block_type = EMPTY_STRING;

    # scalars for remembering statement types across multiple lines
    $statement_type = EMPTY_STRING;     # '' or 'use' or 'sub..' or 'case..'

    # scalars for remembering where we are in the file
    $current_package = "main";
    $context         = UNKNOWN_CONTEXT;

    # hashes used to remember function information
    $ris_constant             = {};     # user-defined constants
    $ris_user_function        = {};     # user-defined functions
    $ruser_function_prototype = {};     # their prototypes
    $ris_block_function       = {};
    $ris_block_list_function  = {};
    $rsaw_function_definition = {};
    $rsaw_use_module          = {};

    # variables used to track depths of various containers
    # and report nesting errors
    $paren_depth              = 0;
    $brace_depth              = 0;
    $square_bracket_depth     = 0;
    $rcurrent_depth           = [ (0) x scalar(@closing_brace_names) ];
    $total_depth              = 0;
    $rtotal_depth             = [];
    $rcurrent_sequence_number = [];
    $ris_lexical_sub          = {};
    $next_sequence_number     = SEQ_ROOT + 1;

    $rparen_type                     = [];
    $rparen_semicolon_count          = [];
    $rparen_vars                     = [];
    $rbrace_type                     = [];
    $rbrace_structural_type          = [];
    $rbrace_context                  = [];
    $rbrace_package                  = [];
    $rsquare_bracket_type            = [];
    $rsquare_bracket_structural_type = [];
    $rdepth_array                    = [];
    $rnested_ternary_flag            = [];
    $rnested_statement_type          = [];
    $rstarting_line_of_current_depth = [];

    $rparen_type->[$paren_depth]            = EMPTY_STRING;
    $rparen_semicolon_count->[$paren_depth] = 0;
    $rparen_vars->[$paren_depth]            = [];
    $rbrace_type->[$brace_depth] = ';';   # identify opening brace as code block
    $rbrace_structural_type->[$brace_depth]        = EMPTY_STRING;
    $rbrace_context->[$brace_depth]                = UNKNOWN_CONTEXT;
    $rbrace_package->[$paren_depth]                = $current_package;
    $rsquare_bracket_type->[$square_bracket_depth] = EMPTY_STRING;
    $rsquare_bracket_structural_type->[$square_bracket_depth] = EMPTY_STRING;

    initialize_tokenizer_state();
    return;
} ## end sub prepare_for_a_new_file

{    ## closure for sub tokenize_this_line

    use constant BRACE          => 0;
    use constant SQUARE_BRACKET => 1;
    use constant PAREN          => 2;
    use constant QUESTION_COLON => 3;

    # TV1: scalars for processing one LINE.
    # Re-initialized on each entry to sub tokenize_this_line.
    my (
        $block_type,        $container_type,    $expecting,
        $i,                 $i_tok,             $input_line,
        $input_line_number, $last_nonblank_i,   $max_token_index,
        $next_tok,          $next_type,         $peeked_ahead,
        $prototype,         $rhere_target_list, $rtoken_map,
        $rtoken_type,       $rtokens,           $tok,
        $type,              $type_sequence,     $indent_flag,
    );

    # TV2: refs to ARRAYS for processing one LINE
    # Re-initialized on each call.
    my $routput_token_list    = [];    # stack of output token indexes
    my $routput_token_type    = [];    # token types
    my $routput_block_type    = [];    # types of code block
    my $routput_type_sequence = [];    # nesting sequential number
    my $routput_indent_flag   = [];    #

    # TV3: SCALARS for quote variables.  These are initialized with a
    # subroutine call and continually updated as lines are processed.
    my (
        $in_quote,           $quote_type,
        $quote_character,    $quote_pos,
        $quote_depth,        $quoted_string_1,
        $quoted_string_2,    $allowed_quote_modifiers,
        $quote_starting_tok, $quote_here_target_2,
    );

    # TV4: SCALARS for multi-line identifiers and
    # statements. These are initialized with a subroutine call
    # and continually updated as lines are processed.
    my ( $id_scan_state, $identifier, $want_paren );

    # TV5: SCALARS for tracking indentation level.
    # Initialized once and continually updated as lines are
    # processed.
    my (
        $nesting_token_string, $nesting_block_string,
        $nesting_block_flag,   $level_in_tokenizer,
    );

    # TV6: SCALARS for remembering several previous
    # tokens. Initialized once and continually updated as
    # lines are processed.
    my (
        $last_nonblank_container_type, $last_nonblank_type_sequence,
        $last_last_nonblank_token,     $last_last_nonblank_type,
        $last_nonblank_prototype,
    );

    # ----------------------------------------------------------------
    # beginning of tokenizer variable access and manipulation routines
    # ----------------------------------------------------------------

    sub initialize_tokenizer_state {

        # GV1: initialized once
        # TV1: initialized on each call
        # TV2: initialized on each call
        # TV3:
        $in_quote                = 0;
        $quote_type              = 'Q';
        $quote_character         = EMPTY_STRING;
        $quote_pos               = 0;
        $quote_depth             = 0;
        $quoted_string_1         = EMPTY_STRING;
        $quoted_string_2         = EMPTY_STRING;
        $allowed_quote_modifiers = EMPTY_STRING;
        $quote_starting_tok      = EMPTY_STRING;
        $quote_here_target_2     = undef;

        # TV4:
        $id_scan_state = EMPTY_STRING;
        $identifier    = EMPTY_STRING;
        $want_paren    = EMPTY_STRING;

        # TV5:
        $nesting_token_string = EMPTY_STRING;
        $nesting_block_string = '1';            # initially in a block
        $nesting_block_flag   = 1;
        $level_in_tokenizer   = 0;

        # TV6:
        $last_nonblank_container_type = EMPTY_STRING;
        $last_nonblank_type_sequence  = EMPTY_STRING;
        $last_last_nonblank_token     = ';';
        $last_last_nonblank_type      = ';';
        $last_nonblank_prototype      = EMPTY_STRING;
        return;
    } ## end sub initialize_tokenizer_state

    sub save_tokenizer_state {

        # Global variables:
        my $rGV1 = [
            $brace_depth,
            $context,
            $current_package,
            $last_nonblank_block_type,
            $last_nonblank_token,
            $last_nonblank_type,
            $next_sequence_number,
            $paren_depth,
            $rbrace_context,
            $rbrace_package,
            $rbrace_structural_type,
            $rbrace_type,
            $rcurrent_depth,
            $rcurrent_sequence_number,
            $ris_lexical_sub,
            $rdepth_array,
            $ris_block_function,
            $ris_block_list_function,
            $ris_constant,
            $ris_user_function,
            $rnested_statement_type,
            $rnested_ternary_flag,
            $rparen_semicolon_count,
            $rparen_vars,
            $rparen_type,
            $rsaw_function_definition,
            $rsaw_use_module,
            $rsquare_bracket_structural_type,
            $rsquare_bracket_type,
            $rstarting_line_of_current_depth,
            $rtotal_depth,
            $ruser_function_prototype,
            $square_bracket_depth,
            $statement_type,
            $total_depth,

        ];

        # Tokenizer closure variables:
        my $rTV1 = [
            $block_type,        $container_type,    $expecting,
            $i,                 $i_tok,             $input_line,
            $input_line_number, $last_nonblank_i,   $max_token_index,
            $next_tok,          $next_type,         $peeked_ahead,
            $prototype,         $rhere_target_list, $rtoken_map,
            $rtoken_type,       $rtokens,           $tok,
            $type,              $type_sequence,     $indent_flag,
        ];

        my $rTV2 = [
            $routput_token_list, $routput_token_type,
            $routput_block_type, $routput_type_sequence,
            $routput_indent_flag,
        ];

        my $rTV3 = [
            $in_quote,           $quote_type,
            $quote_character,    $quote_pos,
            $quote_depth,        $quoted_string_1,
            $quoted_string_2,    $allowed_quote_modifiers,
            $quote_starting_tok, $quote_here_target_2,
        ];

        my $rTV4 = [ $id_scan_state, $identifier, $want_paren ];

        my $rTV5 = [
            $nesting_token_string, $nesting_block_string,
            $nesting_block_flag,   $level_in_tokenizer,
        ];

        my $rTV6 = [
            $last_nonblank_container_type, $last_nonblank_type_sequence,
            $last_last_nonblank_token,     $last_last_nonblank_type,
            $last_nonblank_prototype,
        ];
        return [ $rGV1, $rTV1, $rTV2, $rTV3, $rTV4, $rTV5, $rTV6 ];
    } ## end sub save_tokenizer_state

    sub restore_tokenizer_state {
        my ($rstate) = @_;
        my ( $rGV1, $rTV1, $rTV2, $rTV3, $rTV4, $rTV5, $rTV6 ) = @{$rstate};

        (
            $brace_depth,
            $context,
            $current_package,
            $last_nonblank_block_type,
            $last_nonblank_token,
            $last_nonblank_type,
            $next_sequence_number,
            $paren_depth,
            $rbrace_context,
            $rbrace_package,
            $rbrace_structural_type,
            $rbrace_type,
            $rcurrent_depth,
            $rcurrent_sequence_number,
            $ris_lexical_sub,
            $rdepth_array,
            $ris_block_function,
            $ris_block_list_function,
            $ris_constant,
            $ris_user_function,
            $rnested_statement_type,
            $rnested_ternary_flag,
            $rparen_semicolon_count,
            $rparen_vars,
            $rparen_type,
            $rsaw_function_definition,
            $rsaw_use_module,
            $rsquare_bracket_structural_type,
            $rsquare_bracket_type,
            $rstarting_line_of_current_depth,
            $rtotal_depth,
            $ruser_function_prototype,
            $square_bracket_depth,
            $statement_type,
            $total_depth,

        ) = @{$rGV1};

        (
            $block_type,        $container_type,    $expecting,
            $i,                 $i_tok,             $input_line,
            $input_line_number, $last_nonblank_i,   $max_token_index,
            $next_tok,          $next_type,         $peeked_ahead,
            $prototype,         $rhere_target_list, $rtoken_map,
            $rtoken_type,       $rtokens,           $tok,
            $type,              $type_sequence,     $indent_flag,
        ) = @{$rTV1};

        (
            $routput_token_list, $routput_token_type,
            $routput_block_type, $routput_type_sequence,
            $routput_indent_flag,
        ) = @{$rTV2};

        (
            $in_quote,           $quote_type,
            $quote_character,    $quote_pos,
            $quote_depth,        $quoted_string_1,
            $quoted_string_2,    $allowed_quote_modifiers,
            $quote_starting_tok, $quote_here_target_2,
        ) = @{$rTV3};

        ( $id_scan_state, $identifier, $want_paren ) = @{$rTV4};

        (
            $nesting_token_string, $nesting_block_string,
            $nesting_block_flag,   $level_in_tokenizer,
        ) = @{$rTV5};

        (
            $last_nonblank_container_type, $last_nonblank_type_sequence,
            $last_last_nonblank_token,     $last_last_nonblank_type,
            $last_nonblank_prototype,
        ) = @{$rTV6};
        return;
    } ## end sub restore_tokenizer_state

    sub split_pretoken {

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

        # This provides a way to work around the limitations of the
        # pre-tokenization scheme upon which perltidy is based. It is rarely
        # needed.

        # Split the leading $numc characters from the current token (at
        # index=$i) which is pre-type 'w' and insert the remainder back into
        # the pretoken stream with appropriate settings.  Since we are
        # splitting a pre-type 'w', there are three cases, depending on if the
        # remainder starts with a digit:
        # Case 1: remainder is type 'd', all digits
        # Case 2: remainder is type 'd' and type 'w': digits & other characters
        # Case 3: remainder is type 'w'

        # Examples, for $numc=1:
        #   $tok    => $tok_0 $tok_1 $tok_2
        #   'x10'   => 'x'    '10'                # case 1
        #   'x10if' => 'x'    '10'   'if'         # case 2
        #   '0ne    => 'O'            'ne'        # case 3

        # where:
        #   $tok_1 is a possible string of digits (pre-type 'd')
        #   $tok_2 is a possible word (pre-type 'w')

        # return 1 if successful
        # return undef if error (shouldn't happen)

        # Calling routine should update '$type' and '$tok' if successful.

        my $pretoken = $rtokens->[$i];
        if (   $pretoken
            && length($pretoken) > $numc
            && substr( $pretoken, $numc ) =~ /^(\d*)(.*)$/ )
        {

            # Split $tok into up to 3 tokens:
            my $tok_0 = substr( $pretoken, 0, $numc );
            my $tok_1 = defined($1) ? $1 : EMPTY_STRING;
            my $tok_2 = defined($2) ? $2 : EMPTY_STRING;

            my $len_0 = length($tok_0);
            my $len_1 = length($tok_1);
            my $len_2 = length($tok_2);

            ##my $pre_type_0 = 'w';
            my $pre_type_1 = 'd';
            my $pre_type_2 = 'w';

            my $pos_0 = $rtoken_map->[$i];
            my $pos_1 = $pos_0 + $len_0;
            my $pos_2 = $pos_1 + $len_1;

            my $isplice = $i + 1;

            # Splice in any digits
            if ($len_1) {
                splice @{$rtoken_map},  $isplice, 0, $pos_1;
                splice @{$rtokens},     $isplice, 0, $tok_1;
                splice @{$rtoken_type}, $isplice, 0, $pre_type_1;
                $max_token_index++;
                $isplice++;
            }

            # Splice in any trailing word
            if ($len_2) {
                splice @{$rtoken_map},  $isplice, 0, $pos_2;
                splice @{$rtokens},     $isplice, 0, $tok_2;
                splice @{$rtoken_type}, $isplice, 0, $pre_type_2;
                $max_token_index++;
            }

            $rtokens->[$i] = $tok_0;
            return 1;
        }

        # Shouldn't get here - bad call parameters
        if (DEVEL_MODE) {
            Fault(<<EOM);
While working near line number $input_line_number, bad arg '$tok' passed to sub split_pretoken()
EOM
        }
        return;
    } ## end sub split_pretoken

    sub get_indentation_level {
        return $level_in_tokenizer;
    }

    sub reset_indentation_level {
        $level_in_tokenizer = shift;
        return;
    }

    sub peeked_ahead {
        ( ( my $flag ) ) = @_;

        # get or set the closure flag '$peeked_ahead':
        # - set $peeked_ahead to $flag if given, then
        # - return current value
        $peeked_ahead = defined($flag) ? $flag : $peeked_ahead;
        return $peeked_ahead;
    } ## end sub peeked_ahead

    # ------------------------------------------------------------
    # end of tokenizer variable access and manipulation routines
    # ------------------------------------------------------------

    #------------------------------
    # beginning of tokenizer hashes
    #------------------------------

    my %matching_start_token = ( '}' => '{', ']' => '[', ')' => '(' );

    my @q;

    # 'L' is token for opening { at hash key
    my %is_opening_type;
    @q = qw< L { ( [ >;
    $is_opening_type{$_} = 1 for @q;

    my %is_opening_or_ternary_type;
    push @q, '?';
    $is_opening_or_ternary_type{$_} = 1 for @q;

    # 'R' is token for closing } at hash key
    my %is_closing_type;
    @q = qw< R } ) ] >;
    $is_closing_type{$_} = 1 for @q;

    my %is_closing_or_ternary_type;
    push @q, ':';
    $is_closing_or_ternary_type{$_} = 1 for @q;

    my %is_redo_last_next_goto;
    @q = qw( redo last next goto );
    $is_redo_last_next_goto{$_} = 1 for @q;

    my %is_use_require;
    @q = qw( use require );
    $is_use_require{$_} = 1 for @q;

    # This hash holds the array index in $self for these keywords:
    # Fix for issue c035: removed 'format' from this hash
    my %is_END_DATA = (
        '__END__'  => _in_end_,
        '__DATA__' => _in_data_,
    );

    # table showing how many quoted things to look for after quote operator..
    # s, y, tr have 2 (pattern and replacement)
    # others have 1 (pattern only)
    my %quote_items = (
        's'  => 2,
        'y'  => 2,
        'tr' => 2,
        'm'  => 1,
        'qr' => 1,
        'q'  => 1,
        'qq' => 1,
        'qw' => 1,
        'qx' => 1,
    );

    my %is_for_foreach;
    @q = qw( for foreach );
    $is_for_foreach{$_} = 1 for @q;

    # These keywords may introduce blocks after parenthesized expressions,
    # in the form:
    # keyword ( .... ) { BLOCK }
    # patch for SWITCH/CASE: added 'switch' 'case' 'given' 'when'
    my %is_blocktype_with_paren;
    @q =
      qw(if elsif unless while until for foreach switch case given when catch);
    $is_blocktype_with_paren{$_} = 1 for @q;

    my %is_case_default;
    @q = qw( case default );
    $is_case_default{$_} = 1 for @q;

    #------------------------
    # end of tokenizer hashes
    #------------------------

    # ------------------------------------------------------------
    # beginning of various scanner interface routines
    # ------------------------------------------------------------
    sub scan_replacement_text {

        # check for here-docs in replacement text invoked by
        # a substitution operator with executable modifier 'e'.
        #
        # given:
        #  $replacement_text
        # return:
        #  $rht = reference to any here-doc targets
        my ( $self, $replacement_text ) = @_;

        # quick check
        return if ( $replacement_text !~ /<</ );

        $self->write_logfile_entry(
            "scanning replacement text for here-doc targets\n");

        # save the logger object for error messages
        my $logger_object = $self->[_logger_object_];

        # save all lexical variables
        my $rstate = save_tokenizer_state();
        _decrement_count();    # avoid error check for multiple tokenizers

        # make a new tokenizer
        my $tokenizer = Perl::Tidy::Tokenizer->new(
            source_object        => \$replacement_text,
            logger_object        => $logger_object,
            starting_line_number => $input_line_number,
        );

        # scan the replacement text
        while ( $tokenizer->get_line() ) { }

        # remove any here doc targets
        my $rht = undef;
        if ( $tokenizer->[_in_here_doc_] ) {
            $rht = [];
            push @{$rht},
              [
                $tokenizer->[_here_doc_target_],
                $tokenizer->[_here_quote_character_],
              ];
            if ( $tokenizer->[_rhere_target_list_] ) {
                push @{$rht}, @{ $tokenizer->[_rhere_target_list_] };
                $tokenizer->[_rhere_target_list_] = undef;
            }
            $tokenizer->[_in_here_doc_] = undef;
        }

        # now its safe to report errors
        my $rtokenization_info_uu = $tokenizer->report_tokenization_errors();

        # TODO: Could propagate a severe error up

        # restore all tokenizer lexical variables
        restore_tokenizer_state($rstate);

        # return the here doc targets
        return $rht;
    } ## end sub scan_replacement_text

    sub scan_bare_identifier {
        my $self = shift;

        # Scan a token starting with an alphanumeric variable or package
        # separator, :: or '.

        ( $i, $tok, $type, $prototype ) = $self->scan_bare_identifier_do(

            $input_line,
            $i,
            $tok,
            $type,
            $prototype,
            $rtoken_map,
            $max_token_index,
        );
        return;
    } ## end sub scan_bare_identifier

    sub scan_identifier {

        # Scan for an identifier following a sigil or -> or other
        # identifier prefix, such as '::'

        my $self = shift;

        (

            $i,
            $tok,
            $type,
            $id_scan_state,
            $identifier,
            my $split_pretoken_flag,

        ) = $self->scan_complex_identifier(

            $i,
            $id_scan_state,
            $identifier,
            $rtokens,
            $max_token_index,
            $expecting,
            $rparen_type->[$paren_depth],
        );

        # Check for signal to fix a special variable adjacent to a keyword,
        # such as '$^One$0'.
        if ($split_pretoken_flag) {

            # Try to fix it by splitting the pretoken
            if (   $i > 0
                && $rtokens->[ $i - 1 ] eq '^'
                && $self->split_pretoken(1) )
            {
                $identifier = substr( $identifier, 0, 3 );
                $tok        = $identifier;
            }
            else {

                # This shouldn't happen ...
                my $var    = substr( $tok, 0, 3 );
                my $excess = substr( $tok, 3 );
                $self->interrupt_logfile();
                $self->warning(<<EOM);
$input_line_number: Trouble parsing at characters '$excess' after special variable '$var'.
A space may be needed after '$var'.
EOM
                $self->resume_logfile();
            }
        }
        return;
    } ## end sub scan_identifier

    use constant VERIFY_FASTSCAN => 0;
    my %fast_scan_context;

    BEGIN {
        %fast_scan_context = (
            '$' => SCALAR_CONTEXT,
            '*' => SCALAR_CONTEXT,
            '@' => LIST_CONTEXT,
            '%' => LIST_CONTEXT,
            '&' => UNKNOWN_CONTEXT,
        );
    } ## end BEGIN

    sub scan_simple_identifier {

        my $self = shift;

        # This is a wrapper for sub scan_identifier. It does a fast preliminary
        # scan for certain common identifiers:
        #   '$var', '@var', %var, *var, &var, '@{...}', '%{...}'
        # If it does not find one of these, or this is a restart, it calls the
        # original scanner directly.

        # This gives the same results as the full scanner in about 1/4 the
        # total runtime for a typical input stream.

        # Notation:
        #     $var * 2
        #     ^^   ^
        #     ||  |
        #     ||  ---- $i_next [= next nonblank pretoken ]
        #     |----$i_plus_1 [= a bareword ]
        #     ---$i_begin [= a sigil]

        my $i_begin   = $i;
        my $tok_begin = $tok;
        my $i_plus_1  = $i + 1;
        my $fast_scan_type;

        #-------------------------------------------------------
        # Do full scan for anything following a pointer, such as
        #      $cref->&*;    # a postderef
        #-------------------------------------------------------
        if ( $last_nonblank_token eq '->' ) {

        }

        #------------------------------
        # quick scan with leading sigil
        #------------------------------
        elsif ( !$id_scan_state
            && $i_plus_1 <= $max_token_index
            && $fast_scan_context{$tok} )
        {
            $context = $fast_scan_context{$tok};

            # look for $var, @var, ...
            if ( $rtoken_type->[$i_plus_1] eq 'w' ) {
                my $pretype_next = EMPTY_STRING;
                if ( $i_plus_1 < $max_token_index ) {
                    my $i_next = $i_plus_1 + 1;
                    if (   $rtoken_type->[$i_next] eq 'b'
                        && $i_next < $max_token_index )
                    {
                        $i_next += 1;
                    }
                    $pretype_next = $rtoken_type->[$i_next];
                }
                if ( $pretype_next ne ':' && $pretype_next ne "'" ) {

                    # Found type 'i' like '$var', '@var', or '%var'
                    $identifier     = $tok . $rtokens->[$i_plus_1];
                    $tok            = $identifier;
                    $type           = 'i';
                    $i              = $i_plus_1;
                    $fast_scan_type = $type;
                }
            }

            # Look for @{ or %{  .
            # But we must let the full scanner handle things ${ because it may
            # keep going to get a complete identifier like '${#}'  .
            elsif (
                $rtoken_type->[$i_plus_1] eq '{'
                && (   $tok_begin eq '@'
                    || $tok_begin eq '%' )
              )
            {

                $identifier     = $tok;
                $type           = 't';
                $fast_scan_type = $type;
            }
            else {
                ## out of tricks
            }
        }

        #---------------------------
        # Quick scan with leading ->
        # Look for ->[ and ->{
        #---------------------------
        elsif (
               $tok eq '->'
            && $i < $max_token_index
            && (   $rtokens->[$i_plus_1] eq '{'
                || $rtokens->[$i_plus_1] eq '[' )
          )
        {
            $type           = $tok;
            $fast_scan_type = $type;
            $identifier     = $tok;
            $context        = UNKNOWN_CONTEXT;
        }
        else {
            ## out of tricks
        }

        #--------------------------------------
        # Verify correctness during development
        #--------------------------------------
        if ( VERIFY_FASTSCAN && $fast_scan_type ) {

            # We will call the full method
            my $identifier_simple = $identifier;
            my $tok_simple        = $tok;
            my $i_simple          = $i;
            my $context_simple    = $context;

            $tok = $tok_begin;
            $i   = $i_begin;
            $self->scan_identifier();

            if (   $tok ne $tok_simple
                || $type ne $fast_scan_type
                || $i != $i_simple
                || $identifier ne $identifier_simple
                || $id_scan_state
                || $context ne $context_simple )
            {
                print {*STDERR} <<EOM;
scan_simple_identifier differs from scan_identifier:
simple:  i=$i_simple, tok=$tok_simple, type=$fast_scan_type, ident=$identifier_simple, context='$context_simple
full:    i=$i, tok=$tok, type=$type, ident=$identifier, context='$context state=$id_scan_state
EOM
            }
        }

        #-------------------------------------------------
        # call full scanner if fast method did not succeed
        #-------------------------------------------------
        if ( !$fast_scan_type ) {
            $self->scan_identifier();
        }
        return;
    } ## end sub scan_simple_identifier

    sub method_ok_here {

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

        # Return:
        #   false if this is definitely an invalid method declaration
        #   true otherwise (even if not sure)

        # We are trying to avoid problems with old uses of 'method'
        # when --use-feature=class is set (rt145706).
        # For example, this should cause a return of 'false':

        #  method paint => sub {
        #    return;
        #  };

        # Assume non-method if an error would occur
        return if ( $expecting == OPERATOR );

        # Currently marking a line-ending 'method' as a bareword (fix c532)
        return if ( $i_tok >= $max_token_index );

        # If a '$' follows 'method'...
        # Check for possible Object::Pad lexical method like
        #  'method $var {'
        # TODO: maybe merge this with the code below by increasing pos by 1
        if ( $next_nonblank_token eq '$' && new_statement_ok() ) {
            return 1;
        }

        # Otherwise, not a method if non-word follows ..
        if ( $next_nonblank_token !~ /^[\w\:]/ ) { return }

        # from do_scan_sub:
        my $i_beg   = $i + 1;
        my $pos_beg = $rtoken_map->[$i_beg];
        pos($input_line) = $pos_beg;

        # TEST 1: look a valid sub NAME
        if (
            $input_line =~ m{\G\s*
                ((?:\w*(?:'|::))*)  # package - something that ends in :: or '
                (\w+)               # NAME    - required
                }gcx
          )
        {
            # For possible future use..
            ##my $subname = $2;
            ##my $package = $1 ? $1 : EMPTY_STRING;
        }
        else {
            return;
        }

        # TEST 2: look for invalid characters after name, such as here:
        #    method paint => sub {
        #     ...
        #    }
        my $next_char = EMPTY_STRING;
        if ( $input_line =~ m/\s*(\S)/gcx ) { $next_char = $1 }
        if ( !$next_char || $next_char eq '#' ) {
            ( $next_char, my $i_next_uu ) =
              $self->find_next_nonblank_token( $max_token_index,
                $rtokens, $max_token_index );
        }

        if ( !$next_char ) {

            # out of characters - give up
            return;
        }

        # Possibly valid next token types:
        # '(' could start prototype or signature
        # ':' could start ATTRIBUTE
        # '{' cold start BLOCK
        # ';' or '}' could end a statement
        if ( $next_char !~ /^[\(\:\{\;\}]/ ) {

            # This does not match use feature 'class' syntax
            return;
        }

        # We will stop here and assume that this is valid syntax for
        # use feature 'class'.
        return 1;
    } ## end sub method_ok_here

    sub class_ok_here {

        my $self = shift;

        # Return:
        #   false if this is definitely an invalid class declaration
        #   true otherwise (even if not sure)

        # We are trying to avoid problems with old uses of 'class'
        # when --use-feature=class is set (rt145706).  We look ahead
        # see if this use of 'class' is obviously inconsistent with
        # the syntax of use feature 'class'.  This allows the default
        # setting --use-feature=class to work for old syntax too.

        # Valid class declarations look like
        #   class NAME ?ATTRS ?VERSION ?BLOCK
        # where ATTRS VERSION and BLOCK are optional

        # For example, this should produce a return of 'false':
        #
        #   class ExtendsBasicAttributes is BasicAttributes{

        # TEST 1: class stmt can only go where a new statement can start
        if ( !new_statement_ok() ) { return }

        my $i_beg   = $i + 1;
        my $pos_beg = $rtoken_map->[$i_beg];
        pos($input_line) = $pos_beg;

        # TEST 2: look for a valid NAME
        if (
            $input_line =~ m{\G\s*
                ((?:\w*(?:'|::))*)  # package - something that ends in :: or '
                (\w+)               # NAME    - required
                }gcx
          )
        {
            # For possible future use..
            ##my $subname = $2;
            ##my $package = $1 ? $1 : EMPTY_STRING;
        }
        else {
            return;
        }

        # TEST 3: look for valid characters after NAME
        my $next_char = EMPTY_STRING;
        if ( $input_line =~ m/\s*(\S)/gcx ) { $next_char = $1 }
        if ( !$next_char || $next_char eq '#' ) {
            ( $next_char, my $i_next_uu ) =
              $self->find_next_nonblank_token( $max_token_index,
                $rtokens, $max_token_index );
        }
        if ( !$next_char ) {

            # out of characters - give up
            return;
        }

        # Must see one of: ATTRIBUTE, VERSION, BLOCK, or end stmt

        # Possibly valid next token types:
        # ':' could start ATTRIBUTE
        # '\d' could start VERSION
        # '{' cold start BLOCK
        # ';' could end a statement
        # '}' could end statement but would be strange

        if ( $next_char !~ /^[\:\d\{\;\}]/ ) {

            # This does not match use feature 'class' syntax
            return;
        }

        # We will stop here and assume that this is valid syntax for
        # use feature 'class'.
        return 1;
    } ## end sub class_ok_here

    sub scan_id {
        my $self = shift;

        # Scan for a sub or package name

        ( $i, $tok, $type, $id_scan_state ) = $self->scan_id_do(

            $input_line,
            $i, $tok,
            $rtokens,
            $rtoken_map,
            $id_scan_state,
            $max_token_index,
        );
        return;
    } ## end sub scan_id

    sub scan_number {
        my $self = shift;
        my $number;
        ( $i, $type, $number ) =
          $self->scan_number_do( $input_line, $i, $rtoken_map, $type,
            $max_token_index );
        return $number;
    } ## end sub scan_number

    use constant VERIFY_FASTNUM => 0;

    sub scan_number_fast {

        my $self = shift;

        # This is a wrapper for sub scan_number. It does a fast preliminary
        # scan for a simple integer.  It calls the original scan_number if it
        # does not find one.

        my $i_begin   = $i;
        my $tok_begin = $tok;
        my $number;

        #---------------------------------
        # Quick check for (signed) integer
        #---------------------------------

        # This will be the string of digits:
        my $i_d   = $i;
        my $tok_d = $tok;
        my $typ_d = $rtoken_type->[$i_d];

        # check for signed integer
        my $sign = EMPTY_STRING;
        if (   $typ_d ne 'd'
            && ( $typ_d eq '+' || $typ_d eq '-' )
            && $i_d < $max_token_index )
        {
            $sign = $tok_d;
            $i_d++;
            $tok_d = $rtokens->[$i_d];
            $typ_d = $rtoken_type->[$i_d];
        }

        # Handle integers
        if (
            $typ_d eq 'd'
            && (
                $i_d == $max_token_index
                || (   $i_d < $max_token_index
                    && $rtoken_type->[ $i_d + 1 ] ne '.'
                    && $rtoken_type->[ $i_d + 1 ] ne 'w' )
            )
          )
        {
            # Let the full scanner handle multi-digit integers beginning with
            # '0' because there could be error messages.  For example, '009' is
            # not a valid number.

            if ( $tok_d eq '0' || substr( $tok_d, 0, 1 ) ne '0' ) {
                $number = $sign . $tok_d;
                $type   = 'n';
                $i      = $i_d;
            }
        }

        #--------------------------------------
        # Verify correctness during development
        #--------------------------------------
        if ( VERIFY_FASTNUM && defined($number) ) {

            # We will call the full method
            my $type_simple   = $type;
            my $i_simple      = $i;
            my $number_simple = $number;

            $tok    = $tok_begin;
            $i      = $i_begin;
            $number = $self->scan_number();

            if (   $type ne $type_simple
                || ( $i != $i_simple && $i <= $max_token_index )
                || $number ne $number_simple )
            {
                print {*STDERR} <<EOM;
scan_number_fast differs from scan_number:
simple:  i=$i_simple, type=$type_simple, number=$number_simple
full:  i=$i, type=$type, number=$number
EOM
            }
        }

        #----------------------------------------
        # call full scanner if may not be integer
        #----------------------------------------
        if ( !defined($number) ) {
            $number = $self->scan_number();
        }
        return $number;
    } ## end sub scan_number_fast

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

        # Issue a warning if a binary operator is missing a term to operate on

        # This should only be called if a term is expected here
        if ( $expecting != TERM ) { return }

        # Be sure a TERM is definitely required ..
        if (

            # .. following a binary operator token type, like '='
            $is_binary_or_unary_operator_type{$last_nonblank_type}

            # .. or following a binary keyword operator, like 'and'
            || (   $last_nonblank_type eq 'k'
                && $is_binary_or_unary_keyword{$last_nonblank_token} )

            # .. or for a binary operator following something like a ';'
            || (   $is_not_a_TERM_producer_type{$last_nonblank_type}
                && $is_binary_operator_type{$tok} )
          )
        {

            # We must exclude error checking in sub signatures which have some
            # unusual syntax.  For example the following syntax is okay within
            # a signature:
            #   sub mysub ($=,) {...}
            #   $ = undef
            my $ct = $rparen_type->[$paren_depth];
            if ( $ct && $ct =~ /^sub\b/ ) { return }

            $self->report_unexpected(
                {
                    found           => $tok,
                    expecting       => "term",
                    i_tok           => $i_tok,
                    last_nonblank_i => $last_nonblank_i,
                    rpretoken_map   => $rtoken_map,
                    rpretoken_type  => $rtoken_type,
                    input_line      => $input_line,
                }
            );
            return 1;
        }
        return;
    } ## end sub error_if_expecting_TERM

    # a sub to warn if token found where operator expected
    sub error_if_expecting_OPERATOR {

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

        # Issue warning on error if expecting operator
        # Given:
        #   $thing = the unexpected token or issue
        #          = undef to use current pre-token

        if ( $expecting == OPERATOR ) {
            if ( !defined($thing) ) { $thing = $tok }
            $self->report_unexpected(
                {
                    found           => $thing,
                    expecting       => "operator",
                    i_tok           => $i_tok,
                    last_nonblank_i => $last_nonblank_i,
                    rpretoken_map   => $rtoken_map,
                    rpretoken_type  => $rtoken_type,
                    input_line      => $input_line,
                }
            );
            if ( $i_tok == 0 ) {
                $self->interrupt_logfile();
                $self->warning("Missing ';' or ',' above?\n");
                $self->resume_logfile();
            }
            return 1;
        }
        return;
    } ## end sub error_if_expecting_OPERATOR

    # ------------------------------------------------------------
    # end scanner interfaces
    # ------------------------------------------------------------

    #------------------
    # Tokenization subs
    #------------------
    # An identifier in possible indirect object location followed by any of
    # these tokens: -> , ; } (plus others) is not an indirect object. Fix c257.
    my %Z_test_hash;

    BEGIN {
        my @qZ = qw#
          -> ; } ) ]
          => =~ = == !~ || >= != *= .. && |= .= -= += <= %=
          ^= &&= ||= //= <=>
          #;
        push @qZ, COMMA;
        $Z_test_hash{$_} = 1 for @qZ;
    }

    sub do_DOLLAR_SIGN {

        my $self = shift;

        # '$'
        # start looking for a scalar
        $self->error_if_expecting_OPERATOR("Scalar")
          if ( $expecting == OPERATOR );
        $self->scan_simple_identifier();

        if ( $identifier eq '$^W' ) {
            $self->[_saw_perl_dash_w_] = 1;
        }

        # Check for identifier in indirect object slot
        # (vorboard.pl, sort.t).  Something like:
        #   /^(print|printf|sort|exec|system)$/
        if (
               $is_indirect_object_taker{$last_nonblank_token}
            && $last_nonblank_type eq 'k'
            || ( ( $last_nonblank_token eq '(' )
                && $is_indirect_object_taker{ $rparen_type->[$paren_depth] } )
            || (   $last_nonblank_type eq 'w'
                || $last_nonblank_type eq 'U' )    # possible object
          )
        {

            # An identifier followed by '->' is not indirect object;
            # fixes b1175, b1176. Fix c257: Likewise for other tokens like
            # comma, semicolon, closing brace, and single space.
            my ( $next_nonblank_token, $i_next_uu ) =
              $self->find_next_noncomment_token( $i, $rtokens,
                $max_token_index );
            $type = 'Z' if ( !$Z_test_hash{$next_nonblank_token} );
        }
        return;
    } ## end sub do_DOLLAR_SIGN

    sub do_LEFT_PARENTHESIS {

        my $self = shift;

        # '('
        ++$paren_depth;

        # variable to enable check for brace after closing paren (c230)
        my $want_brace = EMPTY_STRING;

        if ($want_paren) {
            $container_type = $want_paren;
            $want_brace     = $want_paren;
            $want_paren     = EMPTY_STRING;
        }
        elsif ( substr( $statement_type, 0, 3 ) eq 'sub'
            && $statement_type =~ /^sub\b/ )
        {
            $container_type = $statement_type;
        }
        else {
            $container_type = $last_nonblank_token;

            # We can check for a syntax error here of unexpected '(',
            # but this is going to get messy...
            if (
                $expecting == OPERATOR

                # Be sure this is not a method call of the form
                # &method(...), $method->(..), &{method}(...),
                # $ref[2](list) is ok & short for $ref[2]->(list)
                # NOTE: at present, braces in something like &{ xxx }
                # are not marked as a block, we might have a method call.
                # Added ')' to fix case c017, something like ()()()
                && $last_nonblank_token !~ /^(?:[\]\}\)\&]|\-\>)/
              )
            {

                # ref: camel 3 p 703.
                if ( $last_last_nonblank_token eq 'do' ) {
                    $self->complain(
"do SUBROUTINE is deprecated; consider & or -> notation\n"
                    );
                }
                else {

                    # if this is an empty list, (), then it is not an
                    # error; for example, we might have a constant pi and
                    # invoke it with pi() or just pi;
                    my ( $next_nonblank_token, $i_next_uu ) =
                      $self->find_next_nonblank_token( $i, $rtokens,
                        $max_token_index );

                    # Patch for c029: give up error check if
                    # a side comment follows
                    if (   $next_nonblank_token ne ')'
                        && $next_nonblank_token ne '#' )
                    {
                        my $hint;

                        $self->error_if_expecting_OPERATOR('(');

                        if ( $last_nonblank_type eq 'C' ) {
                            $hint =
                              "$last_nonblank_token has a void prototype\n";
                        }
                        elsif ( $last_nonblank_type eq 'i' ) {
                            if (   $i_tok > 0
                                && $last_nonblank_token =~ /^\$/ )
                            {
                                $hint =
                                  "Do you mean '$last_nonblank_token->(' ?";
                                if ( $is_for_foreach{ $rtokens->[0] } ) {
                                    $hint .= " ... or is a ';' missing above?";
                                }
                                $hint .= "\n";
                            }
                        }
                        else {
                            ## no hint
                        }
                        if ($hint) {
                            $self->interrupt_logfile();
                            $self->warning($hint);
                            $self->resume_logfile();
                        }
                    } ## end if ( $next_nonblank_token...
                } ## end else [ if ( $last_last_nonblank_token...
            } ## end if ( $expecting == OPERATOR...
        }

        ( $type_sequence, $indent_flag ) =
          $self->increase_nesting_depth( PAREN, $rtoken_map->[$i_tok] );

        # propagate types down through nested parens
        # for example: the second paren in 'if ((' would be structural
        # since the first is.

        if ( $last_nonblank_token eq '(' ) {
            $type = $last_nonblank_type;
        }

        #     We exclude parens as structural after a ',' because it
        #     causes subtle problems with continuation indentation for
        #     something like this, where the first 'or' will not get
        #     indented.
        #
        #         assert(
        #             __LINE__,
        #             ( not defined $check )
        #               or ref $check
        #               or $check eq "new"
        #               or $check eq "old",
        #         );
        #
        #     Likewise, we exclude parens where a statement can start
        #     because of problems with continuation indentation, like
        #     these:
        #
        #         ($firstline =~ /^#\!.*perl/)
        #         and (print $File::Find::name, "\n")
        #           and (return 1);
        #
        #         (ref($usage_fref) =~ /CODE/)
        #         ? &$usage_fref
        #           : (&blast_usage, &blast_params, &blast_general_params);

        else {
            $type = '{';
        }

        if ( $last_nonblank_type eq ')' ) {
            $self->warning(
                "Syntax error? found token '$last_nonblank_type' then '('\n");
        }

        # git #105: Copy container type and want-brace flag at ') (';
        # propagate the container type onward so that any subsequent brace gets
        # correctly marked.  I have implemented this as a general rule, which
        # should be safe, but if necessary it could be restricted to certain
        # container statement types such as 'for'.
        if ( $last_nonblank_token eq ')' ) {
            my $rvars = $rparen_vars->[$paren_depth];
            if ( defined($rvars) ) {
                $container_type = $rparen_type->[$paren_depth];
                ( my $type_lp_uu, $want_brace ) = @{$rvars};
            }
        }

        $rparen_type->[$paren_depth]            = $container_type;
        $rparen_vars->[$paren_depth]            = [ $type, $want_brace ];
        $rparen_semicolon_count->[$paren_depth] = 0;

        return;

    } ## end sub do_LEFT_PARENTHESIS

    sub do_RIGHT_PARENTHESIS {

        my $self = shift;

        ( $type_sequence, $indent_flag ) =
          $self->decrease_nesting_depth( PAREN, $rtoken_map->[$i_tok] );

        # ')'
        if ( $expecting == TERM ) {
            $self->error_if_expecting_TERM()
              if ( !$self->[_rsaw_unknown_syntax_in_seqno_]->{$type_sequence} );
        }

        my $rvars = $rparen_vars->[$paren_depth];
        if ( defined($rvars) ) {
            my ( $type_lp, $want_brace_uu ) = @{$rvars};
            if ( $type_lp && $type_lp eq '{' ) {
                $type = '}';
            }
        }

        $container_type = $rparen_type->[$paren_depth];

        # restore statement type as 'sub' at closing paren of a signature
        # so that a subsequent ':' is identified as an attribute
        if ( substr( $container_type, 0, 3 ) eq 'sub'
            && $container_type =~ /^sub\b/ )
        {
            $statement_type = $container_type;
        }

        if ( $is_for_foreach{ $rparen_type->[$paren_depth] } ) {
            my $num_sc = $rparen_semicolon_count->[$paren_depth];
            if ( $num_sc > 0 && $num_sc != 2 ) {
                $self->warning("Expected 2 ';' in 'for(;;)' but saw $num_sc\n");
            }
        }

        if ( $paren_depth > 0 ) { $paren_depth-- }
        return;
    } ## end sub do_RIGHT_PARENTHESIS

    sub do_COMMA {

        my $self = shift;

        # ','
        if ( $last_nonblank_type eq COMMA ) {
            $self->complain("Repeated ','s \n");
        }

        # Note that we have to check both token and type here because a
        # comma following a qw list can have last token='(' but type = 'q'
        elsif ( $last_nonblank_token eq '(' && $last_nonblank_type eq '{' ) {
            $self->warning("Unexpected leading ',' after a '('\n");
        }
        else {
            ## Error check added in update c565, moved to end of $code loop.
        }

        # patch for operator_expected: note if we are in the list (use.t)
        if ( $statement_type eq 'use' ) { $statement_type = '_use' }
        return;

    } ## end sub do_COMMA

    sub do_SEMICOLON {

        my $self = shift;

        # ';'
        $context        = UNKNOWN_CONTEXT;
        $statement_type = EMPTY_STRING;
        $want_paren     = EMPTY_STRING;

        if ( $is_for_foreach{ $rparen_type->[$paren_depth] } )
        {    # mark ; in for loop

            # Be careful: we do not want a semicolon such as the
            # following to be included:
            #
            #    for (sort {strcoll($a,$b);} keys %investments) {

            if ( $brace_depth == $rdepth_array->[PAREN]->[BRACE]->[$paren_depth]
                && $square_bracket_depth ==
                $rdepth_array->[PAREN]->[SQUARE_BRACKET]->[$paren_depth] )
            {

                $type = 'f';
                $rparen_semicolon_count->[$paren_depth]++;
            }
        }
        else {
            ## Error check added in update c565, moved to end of $code loop.
        }
        return;
    } ## end sub do_SEMICOLON

    sub do_QUOTATION_MARK {

        my $self = shift;

        # '"'
        $self->error_if_expecting_OPERATOR("String")
          if ( $expecting == OPERATOR );
        $in_quote                = 1;
        $type                    = 'Q';
        $allowed_quote_modifiers = EMPTY_STRING;
        $quote_starting_tok      = $tok;
        $quote_here_target_2     = undef;
        return;
    } ## end sub do_QUOTATION_MARK

    sub do_APOSTROPHE {

        my $self = shift;

        # "'"
        $self->error_if_expecting_OPERATOR("String")
          if ( $expecting == OPERATOR );
        $in_quote                = 1;
        $type                    = 'Q';
        $allowed_quote_modifiers = EMPTY_STRING;
        $quote_starting_tok      = $tok;
        $quote_here_target_2     = undef;
        return;
    } ## end sub do_APOSTROPHE

    sub do_BACKTICK {

        my $self = shift;

        # '`'
        $self->error_if_expecting_OPERATOR("String")
          if ( $expecting == OPERATOR );
        $in_quote                = 1;
        $type                    = 'Q';
        $allowed_quote_modifiers = EMPTY_STRING;
        $quote_starting_tok      = $tok;
        $quote_here_target_2     = undef;
        return;
    } ## end sub do_BACKTICK

    sub do_SLASH {

        my $self = shift;

        # '/'
        my $is_pattern;

        # a pattern cannot follow certain keywords which take optional
        # arguments, like 'shift' and 'pop'. See also '?'.
        if (
            $last_nonblank_type eq 'k'
            && $is_keyword_rejecting_slash_as_pattern_delimiter{
                $last_nonblank_token}
          )
        {
            $is_pattern = 0;
        }
        elsif ( $expecting == UNKNOWN ) {    # indeterminate, must guess..
            (
                $is_pattern,
                my $msg,

            ) = $self->guess_if_pattern_or_division(

                $i,
                $rtokens,
                $rtoken_type,
                $rtoken_map,
                $max_token_index,
            );

            if ($msg) {
                if ( 0 && DEBUG_GUESS_MODE ) {
                    $self->warning("DEBUG_GUESS_MODE message:\n$msg\n");
                }
                $self->write_diagnostics("DIVIDE:$msg\n");
                $self->write_logfile_entry($msg);
            }
        }
        else {
            $is_pattern = ( $expecting == TERM );
        }

        if ($is_pattern) {
            $in_quote                = 1;
            $type                    = 'Q';
            $allowed_quote_modifiers = $quote_modifiers{'m'};
            $quote_starting_tok      = 'm';
            $quote_here_target_2     = undef;
        }
        else {    # not a pattern; check for a /= token

            if ( $rtokens->[ $i + 1 ] eq '=' ) {    # form token /=
                $i++;
                $tok  = '/=';
                $type = $tok;
            }

            #DEBUG - collecting info on what tokens follow a divide
            # for development of guessing algorithm
            ##  if (
            ##      $self->is_possible_numerator( $i, $rtokens,
            ##          $max_token_index ) < 0
            ##    )
            ##  {
            ##      $self->write_diagnostics("DIVIDE? $input_line\n");
            ##  }
        }
        return;
    } ## end sub do_SLASH

    sub do_LEFT_CURLY_BRACKET {

        my $self = shift;

        # '{'
        if ( 0 && $next_tok eq '%' ) {
            ## c583: Spot for possible future check for a '{% ' which starts
            ## a simple macro. If there is a matching closing '%}' on this
            ## line then mark the whole structure as a quote.
        }

        # if we just saw a ')', we will label this block with
        # its type.  We need to do this to allow sub
        # code_block_type to determine if this brace starts a
        # code block or anonymous hash.  (The type of a paren
        # pair is the preceding token, such as 'if', 'else',
        # etc).
        $container_type = EMPTY_STRING;

        # ATTRS: for a '{' following an attribute list, reset
        # things to look like we just saw a sub name
        # Added 'package' (can be 'class') for --use-feature=class (rt145706)
        if ( substr( $statement_type, 0, 3 ) eq 'sub' ) {
            $last_nonblank_token = $statement_type;
            $last_nonblank_type  = 'S';               # c250 change
            $statement_type      = EMPTY_STRING;
        }
        elsif ( substr( $statement_type, 0, 7 ) eq 'package' ) {
            $last_nonblank_token = $statement_type;
            $last_nonblank_type  = 'P';               # c250 change
            $statement_type      = EMPTY_STRING;
        }

        # patch for SWITCH/CASE: hide these keywords from an immediately
        # following opening brace
        elsif ( ( $statement_type eq 'case' || $statement_type eq 'when' )
            && $statement_type eq $last_nonblank_token )
        {
            $last_nonblank_token = ";";
        }

        elsif ( $last_nonblank_token eq ')' ) {
            $last_nonblank_token = $rparen_type->[ $paren_depth + 1 ];

            # defensive move in case of a nesting error (pbug.t)
            # in which this ')' had no previous '('
            # this nesting error will have been caught
            if ( !defined($last_nonblank_token) ) {
                $last_nonblank_token = 'if';
            }

            # Syntax check at '){'
            if ( $is_blocktype_with_paren{$last_nonblank_token} ) {

                my $rvars = $rparen_vars->[ $paren_depth + 1 ];
                if ( defined($rvars) ) {
                    my ( $type_lp_uu, $want_brace ) = @{$rvars};

                    # OLD: Now verify that this is not a trailing form
                    # FIX for git #124: we have to skip this check because
                    # the 'gather' keyword of List::Gather can operate on
                    # a full statement, so it isn't possible to be sure
                    # this is a trailing form.
                    if ( 0 && !$want_brace ) {
                        $self->warning(
"syntax error at ') {', unexpected '{' after closing ')' of a trailing '$last_nonblank_token'\n"
                        );
                    }
                }
            }
            else {
                if ($rOpts_extended_syntax) {

                    # we append a trailing () to mark this as an unknown
                    # block type.  This allows perltidy to format some
                    # common extensions of perl syntax.
                    # This is used by sub code_block_type
                    $last_nonblank_token .= '()';
                }
                else {
                    my $list =
                      join( SPACE, sort keys %is_blocktype_with_paren );
                    $self->warning(
"syntax error at ') {', didn't see one of: <<$list>>; If this code is okay try using the -xs flag\n"
                    );
                }
            }
        }

        # patch for paren-less for/foreach glitch, part 2.
        # see note below under 'qw'
        elsif ($last_nonblank_token eq 'qw'
            && $is_for_foreach{$want_paren} )
        {
            $last_nonblank_token = $want_paren;
            if ( $last_last_nonblank_token eq $want_paren ) {
                $self->warning(
"syntax error at '$want_paren .. {' -- missing \$ loop variable\n"
                );

            }
            $want_paren = EMPTY_STRING;
        }
        else {
            ## not special
        }

        # now identify which of the three possible types of
        # curly braces we have: hash index container, anonymous
        # hash reference, or code block.

        # Patch for Object::Pad "field $var BLOCK"
        if (   $statement_type eq 'field'
            && $last_last_nonblank_token eq 'field'
            && $last_nonblank_type eq 'i'
            && $last_last_nonblank_type eq 'k' )
        {
            $type       = '{';
            $block_type = $statement_type;
        }

        # non-structural (hash index) curly brace pair
        # get marked 'L' and 'R'
        elsif ( is_non_structural_brace() ) {
            $type = 'L';

            # patch for SWITCH/CASE:
            # allow paren-less identifier after 'when'
            # if the brace is preceded by a space
            if (   $statement_type eq 'when'
                && $last_nonblank_type eq 'i'
                && $last_last_nonblank_type eq 'k'
                && ( $i_tok == 0 || $rtoken_type->[ $i_tok - 1 ] eq 'b' ) )
            {
                $type       = '{';
                $block_type = $statement_type;
            }
        }

        # code and anonymous hash have the same type, '{', but are
        # distinguished by 'block_type',
        # which will be blank for an anonymous hash
        else {
            $block_type =
              $self->code_block_type( $i_tok, $rtokens, $rtoken_type,
                $max_token_index );

            # Is a new lexical sub looking for its block sequence number?
            # This is indicated with a special '911' signal.
            if (   $block_type
                && $ris_lexical_sub->{911}
                && $last_nonblank_type eq 'S'
                && substr( $block_type, 0, 3 ) eq 'sub' )
            {
                my ( $subname, $package ) = @{ $ris_lexical_sub->{911} };
                if (   $block_type =~ /^sub $subname/
                    && $is_my_our_state{$last_last_nonblank_token} )
                {
                    $ris_lexical_sub->{$subname}->{$package} =
                      $next_sequence_number;
                }

                # Turn the signal off, even if we did not find the block being
                # sought - it may not exist if the sub statement was a simple
                # declaration without a block definition.
                $ris_lexical_sub->{911} = undef;
            }

            # patch to promote bareword type to function taking block
            if (   $block_type
                && $last_nonblank_type eq 'w'
                && $last_nonblank_i >= 0 )
            {
                if ( $routput_token_type->[$last_nonblank_i] eq 'w' ) {
                    $routput_token_type->[$last_nonblank_i] =
                      $is_grep_alias{$block_type} ? 'k' : 'G';
                }
            }

            # patch for SWITCH/CASE: if we find a stray opening block brace
            # where we might accept a 'case' or 'when' block, then take it
            if (   $statement_type eq 'case'
                || $statement_type eq 'when' )
            {
                if ( !$block_type || $block_type eq '}' ) {
                    $block_type = $statement_type;
                }
            }
        }

        $rbrace_type->[ ++$brace_depth ] = $block_type;

        # Patch for CLASS BLOCK definitions: do not update the package for the
        # current depth if this is a BLOCK type definition.
        # TODO: should make 'class' separate from 'package' and only do
        # this for 'class'
        $rbrace_package->[$brace_depth] = $current_package
          if ( substr( $block_type, 0, 8 ) ne 'package ' );

        $rbrace_structural_type->[$brace_depth] = $type;
        $rbrace_context->[$brace_depth]         = $context;
        ( $type_sequence, $indent_flag ) =
          $self->increase_nesting_depth( BRACE, $rtoken_map->[$i_tok] );

        return;
    } ## end sub do_LEFT_CURLY_BRACKET

    sub do_RIGHT_CURLY_BRACKET {

        my $self = shift;

        # '}'
        $block_type = $rbrace_type->[$brace_depth];
        if ($block_type) { $statement_type = EMPTY_STRING }
        if ( defined( $rbrace_package->[$brace_depth] ) ) {
            $current_package = $rbrace_package->[$brace_depth];
        }
        else {
            ## can happen on brace error (caught elsewhere)
        }
        ( $type_sequence, $indent_flag ) =
          $self->decrease_nesting_depth( BRACE, $rtoken_map->[$i_tok] );

        if ( $expecting == TERM ) {
            $self->error_if_expecting_TERM()
              if (
                !$self->[_rsaw_unknown_syntax_in_seqno_]->{$type_sequence}

                # c583: no error check at a possible end-of-macro combo '%}'
                && $last_nonblank_type ne '%'
              );
        }

        if ( $rbrace_structural_type->[$brace_depth] eq 'L' ) {
            $type = 'R';
        }

        # propagate type information for 'do' and 'eval' blocks, and also
        # for smartmatch operator.  This is necessary to enable us to know
        # if an operator or term is expected next.
        if ( $is_block_operator{$block_type} ) {
            $tok = $block_type;
        }

        # pop non-indenting brace stack if sequence number matches
        if ( @{ $self->[_rnon_indenting_brace_stack_] }
            && $self->[_rnon_indenting_brace_stack_]->[-1] eq $type_sequence )
        {
            pop @{ $self->[_rnon_indenting_brace_stack_] };
        }

        $context = $rbrace_context->[$brace_depth];
        if ( $brace_depth > 0 ) { $brace_depth--; }
        return;
    } ## end sub do_RIGHT_CURLY_BRACKET

    sub do_AMPERSAND {

        my $self = shift;

        # '&' = maybe sub call? start looking
        # We have to check for sub call unless we are sure we
        # are expecting an operator.  This example from s2p
        # got mistaken as a q operator in an early version:
        #   print BODY &q(<<'EOT');
        if ( $expecting != OPERATOR ) {

            # But only look for a sub call if we are expecting a term or
            # if there is no existing space after the &.
            # For example we probably don't want & as sub call here:
            #    Fcntl::S_IRUSR & $mode;
            if ( $expecting == TERM || $next_type ne 'b' ) {
                $self->scan_simple_identifier();
            }
        }
        else {
            ## '&' is an operator
        }
        return;
    } ## end sub do_AMPERSAND

    sub do_LESS_THAN_SIGN {

        my $self = shift;

        # '<' - angle operator or less than?
        if ( $expecting != OPERATOR ) {
            ( $i, $type ) = $self->find_angle_operator_termination(

                $input_line,
                $i,
                $rtoken_map,
                $expecting,
                $max_token_index,
            );
            if ( DEBUG_GUESS_MODE && $expecting == UNKNOWN ) {
                my $msg = "guessing that '<' is ";
                $msg .=
                  $type eq 'Q' ? "an angle operator" : "a less than symbol";
                if ( $type eq 'Q' ) {
                    $self->warning("DEBUG_GUESS_MODE message:\n$msg\n");
                }
            }
        }
        else {
            ## ok:  '<' is less than
        }
        return;
    } ## end sub do_LESS_THAN_SIGN

    sub do_QUESTION_MARK {

        my $self = shift;

        # '?' = conditional or starting pattern?
        my $is_pattern;

        # Patch for rt #126965
        # a pattern cannot follow certain keywords which take optional
        # arguments, like 'shift' and 'pop'. See also '/'.
        if (
            $last_nonblank_type eq 'k'
            && $is_keyword_rejecting_question_as_pattern_delimiter{
                $last_nonblank_token}
          )
        {
            $is_pattern = 0;
        }

        # patch for RT#131288, user constant function without prototype
        # last type is 'U' followed by ?.
        elsif ( $last_nonblank_type =~ /^[FUY]$/ ) {
            $is_pattern = 0;
        }
        elsif ( $expecting == UNKNOWN ) {

            # In older versions of Perl, a bare ? can be a pattern
            # delimiter.  In perl version 5.22 this was
            # dropped, but we have to support it in order to format
            # older programs. See:
            ## https://perl.developpez.com/documentations/en/5.22.0/perl5211delta.html
            # For example, the following line worked
            # at one time:
            #      ?(.*)? && (print $1,"\n");
            # In current versions it would have to be written with slashes:
            #      /(.*)/ && (print $1,"\n");
            (
                $is_pattern,
                my $msg,

            ) = $self->guess_if_pattern_or_conditional(

                $i,
                $rtokens,
                $rtoken_type,
                $rtoken_map,
                $max_token_index,
            );

            if ($msg) {
                $self->write_logfile_entry($msg);
                if ( DEBUG_GUESS_MODE && $is_pattern ) {
                    $self->warning("DEBUG_GUESS_MODE message:\n$msg\n");
                }
            }
        }
        else {
            $is_pattern = ( $expecting == TERM );
        }

        if ($is_pattern) {
            $in_quote                = 1;
            $type                    = 'Q';
            $allowed_quote_modifiers = $quote_modifiers{'m'};
            $quote_starting_tok      = 'm';
            $quote_here_target_2     = undef;
        }
        else {
            ( $type_sequence, $indent_flag ) =
              $self->increase_nesting_depth( QUESTION_COLON,
                $rtoken_map->[$i_tok] );
        }
        return;
    } ## end sub do_QUESTION_MARK

    sub do_STAR {

        my $self = shift;

        # '*' = typeglob, or multiply?

        # Guess based on next token.  See also c036, and versions before 2026-
        if ( $expecting == UNKNOWN && $next_type ne 'b' ) {

            # Check for a normal glob, like *OUT:
            if ( $next_tok =~ /^[_A-Za-z]/ ) {
                $expecting = TERM;
            }
            else {
                ## Could check for glob of a simple punctuation variable here
                ## by looking ahead one more character
            }
        }

        if ( $expecting == TERM ) {
            $self->scan_simple_identifier();
        }
        else {

            if ( $rtokens->[ $i + 1 ] eq '=' ) {
                $tok  = '*=';
                $type = $tok;
                $i++;
            }
            elsif ( $rtokens->[ $i + 1 ] eq '*' ) {
                $tok  = '**';
                $type = $tok;
                $i++;
                if ( $rtokens->[ $i + 1 ] eq '=' ) {
                    $tok  = '**=';
                    $type = $tok;
                    $i++;
                }
            }
            else {
                ## not multiple characters
            }
        }
        return;
    } ## end sub do_STAR

    sub do_DOT {

        my $self = shift;

        # '.' =  what kind of . ?
        if ( $expecting != OPERATOR ) {
            $self->scan_number();
        }
        return;
    } ## end sub do_DOT

    sub do_COLON {

        my $self = shift;

        # ':' = label, ternary, attribute, ?

        # if this is the first nonblank character, call it a label
        # since perl seems to just swallow it
        if ( $input_line_number == 1 && $last_nonblank_i == -1 ) {
            $type = 'J';
        }

        # ATTRS: check for a ':' which introduces an attribute list
        # either after a 'sub' keyword or within a paren list
        # Added 'package' (can be 'class') for --use-feature=class (rt145706)
        elsif ( $statement_type =~ /^(sub|package)\b/ ) {
            $type = 'A';
            $self->[_in_attribute_list_] = 1;
        }

        # Within a signature, unless we are in a ternary.  For example,
        # from 't/filter_example.t':
        #    method foo4 ( $class: $bar ) { $class->bar($bar) }
        elsif ( $rparen_type->[$paren_depth] =~ /^sub\b/
            && !is_balanced_closing_container(QUESTION_COLON) )
        {
            $type = 'A';
            $self->[_in_attribute_list_] = 1;
        }

        # check for scalar attribute, such as
        # my $foo : shared = 1;
        elsif ($is_my_our_state{$statement_type}
            && $rcurrent_depth->[QUESTION_COLON] == 0 )
        {
            $type = 'A';
            $self->[_in_attribute_list_] = 1;
        }

        # Look for Switch::Plain syntax if an error would otherwise occur
        # here. Note that we do not need to check if the extended syntax
        # flag is set because otherwise an error would occur, and we would
        # then have to output a message telling the user to set the
        # extended syntax flag to avoid the error.
        #  case 1: {
        #  default: {
        #  default:
        # Note that the line 'default:' will be parsed as a label elsewhere.
        elsif ( $is_case_default{$statement_type}
            && !is_balanced_closing_container(QUESTION_COLON) )
        {
            # mark it as a perltidy label type
            $type = 'J';
        }

        # mark colon as attribute if an error would occur otherwise; git #162
        elsif ( !$rcurrent_depth->[QUESTION_COLON] ) {
            $type = 'A';
            $self->[_in_attribute_list_] = 1;

            # and set a flag to skip error messages
            my $seqno = $self->[_rseqno_at_depth_]->[$total_depth];
            $self->[_rsaw_unknown_syntax_in_seqno_]->{$seqno} = 1 if ($seqno);
        }

        # otherwise, it should be part of a ?/: operator
        else {
            ( $type_sequence, $indent_flag ) =
              $self->decrease_nesting_depth( QUESTION_COLON,
                $rtoken_map->[$i_tok] );
            if ( $last_nonblank_token eq '?' ) {
                $self->warning("Syntax error near ? :\n");
            }
        }
        return;
    } ## end sub do_COLON

    sub do_PLUS_SIGN {

        my $self = shift;

        # '+' = what kind of plus?
        if ( $expecting == TERM ) {
            my $number = $self->scan_number_fast();

            # unary plus is safest assumption if not a number
            if ( !defined($number) ) { $type = 'p'; }
        }
        elsif ( $expecting == OPERATOR ) {
        }
        else {
            if ( $next_type eq 'w' || $next_type eq '{' ) { $type = 'p' }
        }
        return;
    } ## end sub do_PLUS_SIGN

    sub do_AT_SIGN {

        my $self = shift;

        # '@' = sigil for array?
        $self->error_if_expecting_OPERATOR("Array")
          if ( $expecting == OPERATOR );
        $self->scan_simple_identifier();
        return;
    } ## end sub do_AT_SIGN

    sub do_PERCENT_SIGN {

        my $self = shift;

        # '%' = hash or modulo?
        # first guess is hash if no following blank or paren
        if ( $expecting == UNKNOWN ) {
            if ( $next_type ne 'b' && $next_type ne '(' ) {
                $expecting = TERM;
            }
        }
        if ( $expecting == TERM ) {
            $self->scan_simple_identifier();
        }
        return;
    } ## end sub do_PERCENT_SIGN

    sub do_LEFT_SQUARE_BRACKET {

        my $self = shift;

        # '['
        $rsquare_bracket_type->[ ++$square_bracket_depth ] =
          $last_nonblank_token;
        ( $type_sequence, $indent_flag ) =
          $self->increase_nesting_depth( SQUARE_BRACKET,
            $rtoken_map->[$i_tok] );

        # It may seem odd, but structural square brackets have
        # type '{' and '}'.  This simplifies the indentation logic.
        if ( !is_non_structural_brace() ) {
            $type = '{';
        }
        $rsquare_bracket_structural_type->[$square_bracket_depth] = $type;
        return;
    } ## end sub do_LEFT_SQUARE_BRACKET

    sub do_RIGHT_SQUARE_BRACKET {

        my $self = shift;

        # ']'
        ( $type_sequence, $indent_flag ) =
          $self->decrease_nesting_depth( SQUARE_BRACKET,
            $rtoken_map->[$i_tok] );

        if ( $expecting == TERM ) {
            $self->error_if_expecting_TERM()
              if ( !$self->[_rsaw_unknown_syntax_in_seqno_]->{$type_sequence} );
        }

        if ( $rsquare_bracket_structural_type->[$square_bracket_depth] eq '{' )
        {
            $type = '}';
        }

        # propagate type information for smartmatch operator.  This is
        # necessary to enable us to know if an operator or term is expected
        # next.
        if ( $rsquare_bracket_type->[$square_bracket_depth] eq '~~' ) {
            $tok = $rsquare_bracket_type->[$square_bracket_depth];
        }

        if ( $square_bracket_depth > 0 ) { $square_bracket_depth--; }
        return;
    } ## end sub do_RIGHT_SQUARE_BRACKET

    sub do_MINUS_SIGN {

        my $self = shift;

        # '-' = what kind of minus?
        if ( ( $expecting != OPERATOR )
            && $is_file_test_operator{$next_tok} )
        {
            my ( $next_nonblank_token, $i_next_uu ) =
              $self->find_next_nonblank_token( $i + 1, $rtokens,
                $max_token_index );

            # check for a quoted word like "-w=>xx";
            # it is sufficient to just check for a following '='
            if ( $next_nonblank_token eq '=' ) {
                $type = 'm';
            }
            else {
                $i++;
                $tok .= $next_tok;
                $type = 'F';
            }
        }
        elsif ( $expecting == TERM ) {
            my $number = $self->scan_number_fast();

            # maybe part of bareword token? unary is safest
            if ( !defined($number) ) { $type = 'm'; }

        }
        elsif ( $expecting == OPERATOR ) {
        }
        else {
            if ( $next_type eq 'w' ) {
                $type = 'm';
            }
        }
        return;
    } ## end sub do_MINUS_SIGN

    sub do_CARAT_SIGN {

        my $self = shift;

        # '^'
        # check for special variables like ${^WARNING_BITS}
        if ( $expecting == TERM ) {

            if (   $last_nonblank_token eq '{'
                && ( $next_tok !~ /^\d/ )
                && ( $next_tok =~ /^\w/ ) )
            {

                if ( $next_tok eq 'W' ) {
                    $self->[_saw_perl_dash_w_] = 1;
                }
                $tok  = $tok . $next_tok;
                $i    = $i + 1;
                $type = 'w';

                # Optional coding to try to catch syntax errors. This can
                # be removed if it ever causes incorrect warning messages.
                # The '{^' should be preceded by either by a type or '$#'
                # Examples:
                #   $#{^CAPTURE}       ok
                #   *${^LAST_FH}{NAME} ok
                #   @{^HOWDY}          ok
                #   $hash{^HOWDY}      error

                # Note that a type sigil '$' may be tokenized as 'Z'
                # after something like 'print', so allow type 'Z'
                if (   $last_last_nonblank_type ne 't'
                    && $last_last_nonblank_type ne 'Z'
                    && $last_last_nonblank_token ne '$#' )
                {
                    $self->warning("Possible syntax error near '{^'\n");
                }
            }
        }
        return;
    } ## end sub do_CARAT_SIGN

    sub do_DOUBLE_COLON {

        my $self = shift;

        #  '::' = probably a sub call
        $self->scan_bare_identifier();
        return;
    } ## end sub do_DOUBLE_COLON

    sub do_LEFT_SHIFT {

        my $self = shift;

        # '<<' = maybe a here-doc?
        if ( $expecting != OPERATOR ) {
            my (
                $found_target,
                $here_doc_target,
                $here_quote_character,
                $i_return,
                $saw_error,

            ) = $self->find_here_doc(

                $expecting,
                $i,
                $rtokens,
                $rtoken_type,
                $rtoken_map,
                $max_token_index,
            );
            $i = $i_return;

            if ($found_target) {
                push @{$rhere_target_list},
                  [ $here_doc_target, $here_quote_character ];
                $type = 'h';
                if ( length($here_doc_target) > 80 ) {
                    my $truncated = substr( $here_doc_target, 0, 80 );
                    $self->complain("Long here-target: '$truncated' ...\n");
                }
                elsif ( !$here_doc_target ) {
                    $self->warning(
                        'Use of bare << to mean <<"" is deprecated' . "\n" )
                      if ( !$here_quote_character );
                }
                elsif ( $here_doc_target !~ /^[A-Z_]\w+$/ ) {
                    $self->complain(
                        "Unconventional here-target: '$here_doc_target'\n");
                }
                else {
                    ## nothing to complain about
                }
            }
            elsif ( $expecting == TERM ) {
                if ( !$saw_error ) {

                    # shouldn't happen..arriving here implies an error in
                    # the logic in sub 'find_here_doc'
                    if (DEVEL_MODE) {
                        Fault(<<EOM);
Program bug; didn't find here doc target
EOM
                    }
                    $self->warning(
                        "Possible program error: didn't find here doc target\n"
                    );
                    $self->report_definite_bug();
                }
            }

            # target not found, expecting == UNKNOWN
            else {
                ## assume it is a shift
            }
        }
        else {
            ## '<<' is shift
        }
        return;
    } ## end sub do_LEFT_SHIFT

    sub do_NEW_HERE_DOC {

        # '<<~' = a here-doc, new type added in v26

        my $self = shift;

        return
          if ( $i >= $max_token_index );  # here-doc not possible if end of line
        if ( $expecting != OPERATOR ) {
            my (
                $found_target,
                $here_doc_target,
                $here_quote_character,
                $i_return,
                $saw_error,

            ) = $self->find_here_doc(

                $expecting,
                $i,
                $rtokens,
                $rtoken_type,
                $rtoken_map,
                $max_token_index,
            );
            $i = $i_return;

            if ($found_target) {

                if ( length($here_doc_target) > 80 ) {
                    my $truncated = substr( $here_doc_target, 0, 80 );
                    $self->complain("Long here-target: '$truncated' ...\n");
                }
                elsif ( $here_doc_target !~ /^[A-Z_]\w+$/ ) {
                    $self->complain(
                        "Unconventional here-target: '$here_doc_target'\n");
                }
                else {
                    ## nothing to complain about
                }

                # Note that we put a leading space on the here quote
                # character indicate that it may be preceded by spaces
                $here_quote_character = SPACE . $here_quote_character;
                push @{$rhere_target_list},
                  [ $here_doc_target, $here_quote_character ];
                $type = 'h';
            }

            # target not found ..
            elsif ( $expecting == TERM ) {
                if ( !$saw_error ) {

                    # shouldn't happen..arriving here implies an error in
                    # the logic in sub 'find_here_doc'
                    if (DEVEL_MODE) {
                        Fault(<<EOM);
Program bug; didn't find here doc target
EOM
                    }
                    $self->warning(
                        "Possible program error: didn't find here doc target\n"
                    );
                    $self->report_definite_bug();
                }
            }

            # Target not found, expecting==UNKNOWN
            else {
                $self->warning("didn't find here doc target after '<<~'\n");
            }
        }
        else {
            $self->error_if_expecting_OPERATOR();
        }
        return;
    } ## end sub do_NEW_HERE_DOC

    sub do_POINTER {

        #  '->'
        return;
    }

    sub do_PLUS_PLUS {

        my $self = shift;

        # '++'
        # type = 'pp' for pre-increment, '++' for post-increment
        if    ( $expecting == OPERATOR ) { $type = '++' }
        elsif ( $expecting == TERM )     { $type = 'pp' }

        # handle ( $expecting == UNKNOWN )
        else {

            # look ahead ..
            my ( $next_nonblank_token, $i_next ) =
              $self->find_next_nonblank_token( $i, $rtokens, $max_token_index );

            # Fix for c042: look past a side comment
            if ( $next_nonblank_token eq '#' ) {
                ( $next_nonblank_token, $i_next ) =
                  $self->find_next_nonblank_token( $max_token_index,
                    $rtokens, $max_token_index );
            }

            if ( $next_nonblank_token eq '$' ) { $type = 'pp' }
        }
        return;
    } ## end sub do_PLUS_PLUS

    sub do_FAT_COMMA {

        my $self = shift;

        # '=>'
        if ( $last_nonblank_type eq $tok ) {
            $self->complain("Repeated '=>'s \n");
        }

        # patch for operator_expected: note if we are in the list (use.t)
        # TODO: make version numbers a new token type
        if ( $statement_type eq 'use' ) { $statement_type = '_use' }
        return;
    } ## end sub do_FAT_COMMA

    sub do_MINUS_MINUS {

        my $self = shift;

        # '--'
        # type = 'mm' for pre-decrement, '--' for post-decrement

        if    ( $expecting == OPERATOR ) { $type = '--' }
        elsif ( $expecting == TERM )     { $type = 'mm' }

        # handle ( $expecting == UNKNOWN )
        else {

            # look ahead ..
            my ( $next_nonblank_token, $i_next ) =
              $self->find_next_nonblank_token( $i, $rtokens, $max_token_index );

            # Fix for c042: look past a side comment
            if ( $next_nonblank_token eq '#' ) {
                ( $next_nonblank_token, $i_next ) =
                  $self->find_next_nonblank_token( $max_token_index,
                    $rtokens, $max_token_index );
            }

            if ( $next_nonblank_token eq '$' ) { $type = 'mm' }
        }

        return;
    } ## end sub do_MINUS_MINUS

    sub do_DIGITS {

        my $self = shift;

        # 'd' = string of digits
        $self->error_if_expecting_OPERATOR("Number")
          if ( $expecting == OPERATOR );

        my $number = $self->scan_number_fast();
        if ( !defined($number) ) {

            # shouldn't happen - we should always get a number
            if (DEVEL_MODE) {
                Fault(<<EOM);
non-number beginning with digit--program bug
EOM
            }
            $self->warning(
                "Unexpected error condition: non-number beginning with digit\n"
            );
            $self->report_definite_bug();
        }
        return;
    } ## end sub do_DIGITS

    sub do_ATTRIBUTE_LIST {

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

        # Called at a bareword encountered while in an attribute list
        # returns 'is_attribute':
        #    true if attribute found
        #    false if an attribute (continue parsing bareword)

        # treat bare word followed by open paren like qw(
        if ( $next_nonblank_token eq '(' ) {

            # For something like:
            #     : prototype($$)
            # we should let do_scan_sub see it so that it can see
            # the prototype.  All other attributes get parsed as a
            # quoted string.
            if ( $tok eq 'prototype' ) {
                $id_scan_state = 'prototype';

                # start just after the word 'prototype'
                my $i_beg = $i + 1;
                ( $i, $tok, $type, $id_scan_state ) = $self->do_scan_sub(
                    {
                        input_line      => $input_line,
                        i               => $i,
                        i_beg           => $i_beg,
                        tok             => $tok,
                        type            => $type,
                        rtokens         => $rtokens,
                        rtoken_map      => $rtoken_map,
                        id_scan_state   => $id_scan_state,
                        max_token_index => $max_token_index,
                    }
                );

                # If successful, mark as type 'q' to be consistent
                # with other attributes.  Type 'w' would also work.
                if ( $i > $i_beg ) {
                    $type = 'q';
                    return 1;
                }

                # If not successful, continue and parse as a quote.
            }

            # All other attribute lists must be parsed as quotes
            # (see 'signatures.t' for good examples)
            $in_quote                = $quote_items{'q'};
            $allowed_quote_modifiers = $quote_modifiers{'q'};
            $quote_starting_tok      = 'q';
            $type                    = 'q';
            $quote_type              = 'q';
            $quote_here_target_2     = undef;
            return 1;
        }

        # handle bareword not followed by open paren
        else {
            $type = 'w';
            return 1;
        }

        # attribute not found
        return;
    } ## end sub do_ATTRIBUTE_LIST

    sub do_X_OPERATOR {

        my $self = shift;

        # We are at a pretoken starting with 'x' where an operator is expected

        if ( $tok eq 'x' ) {
            if ( $rtokens->[ $i + 1 ] eq '=' ) {    # x=
                $tok  = 'x=';
                $type = $tok;
                $i++;
            }
            else {
                $type = 'x';
            }
        }
        else {

            # Split a pretoken like 'x10' into 'x' and '10'.
            # Note: In previous versions of perltidy it was marked
            # as a number, $type = 'n', and fixed downstream by the
            # Formatter.
            $type = 'n';
            if ( $self->split_pretoken(1) ) {
                $type = 'x';
                $tok  = 'x';
            }
        }
        return;
    } ## end sub do_X_OPERATOR

    sub do_USE_CONSTANT {

        my $self = shift;

        # We just saw 'use constant' and must look ahead

        $self->scan_bare_identifier();
        my ( $next_nonblank_tok2, $i_next2_uu ) =
          $self->find_next_nonblank_token( $i, $rtokens, $max_token_index );

        if ($next_nonblank_tok2) {

            if ( $is_keyword{$next_nonblank_tok2} ) {

                # Assume qw is used as a quote and okay, as in:
                #  use constant qw{ DEBUG 0 };
                # Not worth trying to parse for just a warning

                # NOTE: This warning is deactivated because recent
                # versions of perl do not complain here, but
                # the coding is retained for reference.
                if ( 0 && $next_nonblank_tok2 ne 'qw' ) {
                    $self->warning(
"Attempting to define constant '$next_nonblank_tok2' which is a perl keyword\n"
                    );
                }
            }

            else {
                $ris_constant->{$current_package}->{$next_nonblank_tok2} = 1;
            }
        }
        return;
    } ## end sub do_USE_CONSTANT

    sub do_KEYWORD {

        my $self = shift;

        # found a keyword - set any associated flags
        $type = 'k';

        # Since for and foreach may not be followed immediately
        # by an opening paren, we have to remember which keyword
        # is associated with the next '('
        # Previously, before update   c230 : if ( $is_for_foreach{$tok} ) {
        ##(if elsif unless while until for foreach switch case given when catch)
        if ( $is_blocktype_with_paren{$tok} ) {
            if ( new_statement_ok() ) {
                $want_paren = $tok;
            }
        }

        # Catch some unexpected keyword errors; c517.
        # Note that we only check keywords for OPERATOR expected, not TERM.
        # This is because a large number of keywords which normally expect
        # a TERM will also take an OPERATOR.
        if ( $expecting == OPERATOR && $is_TERM_keyword{$tok} ) {
            $self->error_if_expecting_OPERATOR();
        }

        # recognize 'use' statements, which are special
        if ( $is_use_require{$tok} ) {
            $statement_type = $tok;
        }

        # remember my and our to check for trailing ": shared"
        elsif ( $is_my_our_state{$tok} ) {
            $statement_type = $tok;
        }

        # Check for unexpected 'elsif'
        elsif ( $tok eq 'elsif' ) {
            if (

                !$is_if_elsif_unless{$last_nonblank_block_type}

                # Allow isolated blocks of any kind during editing
                # by checking for a last noblank token of ';' and no
                # sequence numbers having been issued (c272). The check
                # on sequence number is not perfect but good enough.
                && !(
                       $last_nonblank_token eq ';'
                    && $next_sequence_number == SEQ_ROOT + 1
                )

              )
            {
                ## prevent formatting and avoid instability (b1553)
                $self->warning_do_not_format(
                    "expecting '$tok' to follow one of 'if|elsif|unless'\n");
            }
        }

        # Check for unexpected 'else'
        elsif ( $tok eq 'else' ) {

            # patched for SWITCH/CASE
            if (

                !$is_if_elsif_unless_case_when{$last_nonblank_block_type}

                # patch to avoid an unwanted error message for
                # the case of a parenless 'case' (RT 105484):
                # switch ( 1 ) { case x { 2 } else { } }
                && !$is_if_elsif_unless_case_when{$statement_type}

                # Allow isolated blocks of any kind during editing (c272)
                && !(
                       $last_nonblank_token eq ';'
                    && $next_sequence_number == SEQ_ROOT + 1
                )

              )
            {
                ## prevent formatting and avoid instability (b1553)
                $self->warning_do_not_format(
"expecting '$tok' to follow one of 'if|elsif|unless|case|when'\n"
                );
            }
        }

        # patch for SWITCH/CASE if 'case' and 'when are
        # treated as keywords.  Also 'default' for Switch::Plain
        elsif ($tok eq 'when'
            || $tok eq 'case'
            || $tok eq 'default' )
        {
            $statement_type = $tok;    # next '{' is block
        }

        # feature 'err' was removed in Perl 5.10.  So mark this as
        # a bareword unless an operator is expected (see c158).
        elsif ( $tok eq 'err' ) {
            if ( $expecting != OPERATOR ) { $type = 'w' }
        }
        else {
            ## no special treatment needed
        }

        return;
    } ## end sub do_KEYWORD

    sub do_QUOTE_OPERATOR {

        my $self = shift;

        # We have arrived at a quote operator: q, qq, qw, qx, qr, s, y, tr, m

        if ( $expecting == OPERATOR ) {

            # Be careful not to call an error for a qw quote
            # where a parenthesized list is allowed.  For example,
            # it could also be a for/foreach construct such as
            #
            #    foreach my $key qw\Uno Due Tres Quadro\ {
            #        print "Set $key\n";
            #    }
            #

            # Or it could be a function call.
            # NOTE: Braces in something like &{ xxx } are not
            # marked as a block, we might have a method call.
            # &method(...), $method->(..), &{method}(...),
            # $ref[2](list) is ok & short for $ref[2]->(list)
            #
            # See notes in 'sub code_block_type' and
            # 'sub is_non_structural_brace'

            my $paren_list_possible = $tok eq 'qw'
              && ( $last_nonblank_token =~ /^([\]\}\&]|\-\>)/
                || $is_for_foreach{$want_paren} );

            if ( !$paren_list_possible ) {
                $self->error_if_expecting_OPERATOR();
            }
        }
        $in_quote                = $quote_items{$tok};
        $allowed_quote_modifiers = $quote_modifiers{$tok};
        $quote_starting_tok      = $tok;
        $quote_here_target_2     = undef;

        # All quote types are 'Q' except possibly qw quotes.
        # qw quotes are special in that they may generally be trimmed
        # of leading and trailing whitespace.  So they are given a
        # separate type, 'q', unless requested otherwise.
        $type =
          ( $tok eq 'qw' && $rOpts_trim_qw )
          ? 'q'
          : 'Q';
        $quote_type = $type;
        return;
    } ## end sub do_QUOTE_OPERATOR

    sub do_UNKNOWN_BAREWORD {

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

        # We have encountered a bareword which needs more work to classify

        $self->scan_bare_identifier();

        if (   $statement_type eq 'use'
            && $last_nonblank_token eq 'use' )
        {
            $rsaw_use_module->{$current_package}->{$tok} = 1;
        }

        if ( $type eq 'w' ) {

            if ( $expecting == OPERATOR ) {

                # Patch to avoid error message for RPerl overloaded
                # operator functions: use overload
                #    '+' => \&sse_add,
                #    '-' => \&sse_sub,
                #    '*' => \&sse_mul,
                #    '/' => \&sse_div;
                # TODO: this could eventually be generalized
                if (   $rsaw_use_module->{$current_package}->{'RPerl'}
                    && $tok =~ /^sse_(mul|div|add|sub)$/ )
                {

                }

                # patch for Syntax::Operator::In, git #162
                elsif ( $tok eq 'in' && $next_nonblank_token eq ':' ) {

                }

                # Fix part 1 for git #63 in which a comment falls
                # between an -> and the following word.  An
                # alternate fix would be to change operator_expected
                # to return an UNKNOWN for this type.
                elsif ( $last_nonblank_type eq '->' ) {

                }

                # don't complain about possible indirect object
                # notation.
                # For example:
                #   package main;
                #   sub new($) { ... }
                #   $b = new A::;  # calls A::new
                #   $c = new A;    # same thing but suspicious
                # This will call A::new but we have a 'new' in
                # main:: which looks like a constant.
                #
                elsif ( $last_nonblank_type eq 'C' ) {
                    if ( $tok !~ /::$/ ) {
                        $self->complain(<<EOM);
Expecting operator after '$last_nonblank_token' but found bare word '$tok'
       Maybe indirect object notation?
EOM
                    }
                }
                else {
                    $self->error_if_expecting_OPERATOR("bareword");
                }
            }

            # mark bare words immediately followed by a paren as
            # functions
            $next_tok = $rtokens->[ $i + 1 ];
            if ( $next_tok eq '(' ) {

                # Patch for issue c151, where we are processing a snippet and
                # have not seen that SPACE is a constant.  In this case 'x' is
                # probably an operator. The only disadvantage with an incorrect
                # guess is that the space after it may be incorrect. For example
                #   $str .= SPACE x ( 16 - length($str) ); See also b1410.
                if ( $tok eq 'x' && $last_nonblank_type eq 'w' ) { $type = 'x' }

                # Fix part 2 for git #63.  Leave type as 'w' to keep
                # the type the same as if the -> were not separated
                elsif ( $last_nonblank_type ne '->' ) { $type = 'U' }

                # not a special case
                else { }

            }

            # underscore after file test operator is file handle
            if ( $tok eq '_' && $last_nonblank_type eq 'F' ) {
                $type = 'Z';
            }

            # patch for SWITCH/CASE if 'case' and 'when are
            # not treated as keywords:
            if (
                ( $tok eq 'case' && $rbrace_type->[$brace_depth] eq 'switch' )
                || (   $tok eq 'when'
                    && $rbrace_type->[$brace_depth] eq 'given' )
              )
            {
                $statement_type = $tok;    # next '{' is block
                $type           = 'k';     # for keyword syntax coloring
            }
            if ( $next_nonblank_token eq '(' ) {

                # patch for SWITCH/CASE if switch and given not keywords
                # Switch is not a perl 5 keyword, but we will gamble
                # and mark switch followed by paren as a keyword.  This
                # is only necessary to get html syntax coloring nice,
                # and does not commit this as being a switch/case.
                if ( $tok eq 'switch' || $tok eq 'given' ) {
                    $type = 'k';    # for keyword syntax coloring
                }

                # mark 'x' as operator for something like this (see b1410)
                #  my $line = join( LD_X, map { LD_H x ( $_ + 2 ) } @$widths );
                elsif ( $tok eq 'x' && $last_nonblank_type eq 'w' ) {
                    $type = 'x';
                }
                else {
                    ## not a special case
                }
            }
        }
        return;
    } ## end sub do_UNKNOWN_BAREWORD

    sub sub_attribute_ok_here {

        my ( $self, $tok_kw, $next_nonblank_token, $i_next ) = @_;

        # Decide if a ':' can introduce an attribute. For example,
        # something like 'sub :'

        # Given:
        #   $tok_kw = a bareword token
        #   $next_nonblank_token = a following ':' being examined
        #   $i_next = the index of the following ':'

        # We will decide based on if the colon is followed by a bareword
        # which is not a keyword.  Changed inext+1 to inext to fixed case
        # b1190.
        my $sub_attribute_ok_here;
        if (   $is_sub{$tok_kw}
            && $expecting != OPERATOR
            && $next_nonblank_token eq ':' )
        {
            my ( $nn_nonblank_token, $i_nn_uu ) =
              $self->find_next_nonblank_token( $i_next, $rtokens,
                $max_token_index );
            $sub_attribute_ok_here =
                 $nn_nonblank_token =~ /^\w/
              && $nn_nonblank_token !~ /^\d/
              && !$is_keyword{$nn_nonblank_token};
        }
        return $sub_attribute_ok_here;
    } ## end sub sub_attribute_ok_here

    use constant DEBUG_BAREWORD => 0;

    sub saw_bareword_function {
        my ( $self, $bareword ) = @_;
        $self->[_rbareword_info_]->{$current_package}->{$bareword}
          ->{function_count}++;
        return;
    } ## end sub saw_bareword_function

    sub saw_bareword_constant {
        my ( $self, $bareword ) = @_;
        $self->[_rbareword_info_]->{$current_package}->{$bareword}
          ->{constant_count}++;
        return;
    } ## end sub saw_bareword_constant

    sub get_bareword_counts {
        my ( $self, $bareword ) = @_;

        # Given:
        #   $bareword = a bareword
        # Return:
        #   $function_count = number of times seen as function taking >0 args
        #   $constant_count = number of times seen as function taking  0 args
        # Note:
        #   $function_count > 0 implies that a TERM should come next
        #   $constant_count > 0 implies that an OPERATOR **may** come next,
        #      but this can be incorrect if $bareword can take 0 or more args.
        # This is used to help guess tokenization around unknown barewords.
        my $function_count;
        my $constant_count;
        my $rbareword_info_tok = $self->[_rbareword_info_]->{$current_package};
        if ($rbareword_info_tok) {
            $rbareword_info_tok = $rbareword_info_tok->{$bareword};
            if ($rbareword_info_tok) {
                $function_count = $rbareword_info_tok->{function_count};
                $constant_count = $rbareword_info_tok->{constant_count};

                # a positive function count overrides a constant count
                if ($function_count) { $constant_count = 0 }
            }
        }
        if ( !defined($function_count) ) { $function_count = 0 }
        if ( !defined($constant_count) ) { $constant_count = 0 }
        return ( $function_count, $constant_count );
    } ## end sub get_bareword_counts

    # hashes used to help determine a bareword type
    my %is_wiUC;
    my %is_function_follower;
    my %is_constant_follower;
    my %is_use_require_no;

    BEGIN {
        my @qz = qw( w i U C );
        $is_wiUC{$_} = 1 for @qz;

        @qz = qw( use require no );
        $is_use_require_no{$_} = 1 for @qz;

        # These pre-token types after a bareword imply that it
        # is not a constant, except when '(' is followed by ')'.
        @qz = qw# ( [ { $ @ " ' m #;
        $is_function_follower{$_} = 1 for @qz;

        # These pre-token types after a bareword imply that it
        # MIGHT be a constant, but it also might be a function taking
        # 0 or more call args.
        @qz = qw# ; ) ] } if unless #;
        push @qz, COMMA;
        $is_constant_follower{$_} = 1 for @qz;
    }

    sub do_BAREWORD {

        my ($self) = @_;

        # handle a bareword token:
        # returns
        #    true if this token ends the current line
        #    false otherwise

        my $next_nonblank_token;
        my $i_next = $i + 1;
        if ( $i_next <= $max_token_index && $rtoken_type->[$i_next] eq 'b' ) {
            $i_next++;
        }
        if ( $i_next <= $max_token_index ) {
            $next_nonblank_token = $rtokens->[$i_next];
        }
        else {
            ( $next_nonblank_token, $i_next ) =
              $self->find_next_nonblank_token( $i, $rtokens, $max_token_index );
        }

        # Fix for git #182: If --use-feature=class is set, then
        # a colon between words 'ADJUST' and 'params', and on the same line,
        # does not form the label 'ADJUST:'. It will get marked as type 'A'.
        my $is_not_label;
        if (   $tok eq 'ADJUST'
            && $is_code_block_token{$tok}
            && $rtokens->[$i_next] eq ':'
            && $i_next < $max_token_index )
        {
            my $i_next2 =
              $rtoken_type->[ $i_next + 1 ] eq 'b' ? $i_next + 2 : $i_next + 1;
            $is_not_label =
              (      $i_next2 <= $max_token_index
                  && $rtoken_type->[$i_next2] eq 'w'
                  && $rtokens->[$i_next2] eq 'params' );
        }

        # a bare word immediately followed by :: is not a keyword;
        # use $tok_kw when testing for keywords to avoid a mistake
        my $tok_kw = $tok;
        if (   $rtokens->[ $i + 1 ] eq ':'
            && $rtokens->[ $i + 2 ] eq ':' )
        {
            $tok_kw .= '::';
        }

        if ( $self->[_in_attribute_list_] ) {
            my $is_attribute = $self->do_ATTRIBUTE_LIST($next_nonblank_token);
            return if ($is_attribute);
        }

        #-----------------------------------------
        # Preliminary check for a lexical sub name
        #-----------------------------------------
        my $is_lexical_sub_type;

        # Has this name been seen as a lexical sub?
        if ( my $rseqno_hash = $ris_lexical_sub->{$tok_kw} ) {

            # Look back up the stack to see if it is still in scope.
            # Use the deepest we find if there are multiple versions.
            my @seqno_tested;
            my $cd_aa = $rcurrent_depth->[BRACE];
            foreach my $cd ( reverse( 0 .. $cd_aa ) ) {
                my $p_seqno =
                    $cd
                  ? $rcurrent_sequence_number->[BRACE]->[$cd]
                  : SEQ_ROOT;

                push @seqno_tested, $p_seqno;

                # Lexical subs use their containing sequence number as package
                if ( my $seqno_brace = $rseqno_hash->{$p_seqno} ) {

                    # This sub is in scope .. lookup its type
                    $is_lexical_sub_type =
                        $ris_constant->{$p_seqno}->{$tok_kw}            ? 'C'
                      : $ris_block_function->{$p_seqno}->{$tok_kw}      ? 'G'
                      : $ris_block_list_function->{$p_seqno}->{$tok_kw} ? 'G'
                      : $ris_user_function->{$p_seqno}->{$tok_kw}       ? 'U'
                      :                                                   'U';

                    # But lexical subs do not apply within their defining code
                    foreach (@seqno_tested) {
                        next if ( $_ != $seqno_brace );
                        $is_lexical_sub_type = undef;
                        last;
                    }

                    last;
                }
            }
        }

        #----------------------------------------
        # Starting final if-elsif- chain of tests
        #----------------------------------------

        # This is the return flag:
        #   true => this is the last token on the line
        #   false => keep tokenizing the line
        my $is_last;

        # The following blocks of code must update these vars:
        # $type - the final token type, must always be set

        # In addition, if additional pretokens are added:
        # $tok  - the final token
        # $i    - the index of the last pretoken

        # They may also need to check and set various flags

        # Scan a bare word following a -> as an identifier; it could
        # have a long package name.  Fixes c037, c041.
        if ( $last_nonblank_token eq '->' ) {
            $self->scan_bare_identifier();

            # a bareward after '->' gets type 'i'
            $type = 'i';
        }

        # Quote a word followed by => operator
        elsif (
            ( $next_nonblank_token eq '=' && $rtokens->[ $i_next + 1 ] eq '>' )

            # unless the word is __END__ or __DATA__ and is the only word on
            # the line.
            && ( !defined( $is_END_DATA{$tok_kw} )
                || $input_line !~ /^\s*__(?:END|DATA)__\s*$/ )
          )
        {
            # Bareword followed by a fat comma - see 'git18.in'
            # This code was previously sub do_QUOTED_BAREWORD: see c316, c317

            # Older perl:
            #   'v25=>1'   is a v-string key!
            #   '-v25=>1'  is also a v-string key!
            # Deactivated: this is no longer true; see git #165
            if ( 0 && $tok =~ /^v\d+$/ ) {
                $type = 'v';
                $self->complain("v-string used as hash key\n");
                $self->report_v_string($tok);
            }

            # If tok is something like 'x17' then it could
            # actually be operator x followed by number 17.
            # For example, here:
            #     123x17 => [ 792, 1224 ],
            # (a key of 123 repeated 17 times, perhaps not
            # what was intended). We will mark x17 as type
            # 'n' and it will be split. If the previous token
            # was also a bareword then it is not very clear is
            # going on.  In this case we will not be sure that
            # an operator is expected, so we just mark it as a
            # bareword.  Perl is a little murky in what it does
            # with stuff like this, and its behavior can change
            # over time.  Something like
            #    a x18 => [792, 1224], will compile as
            # a key with 18 a's.  But something like
            #    push @array, a x18;
            # is a syntax error.
            elsif (
                   $expecting == OPERATOR
                && substr( $tok, 0, 1 ) eq 'x'
                && ( length($tok) == 1
                    || substr( $tok, 1, 1 ) =~ /^\d/ )
              )
            {
                $type = 'n';
                if ( $self->split_pretoken(1) ) {
                    $type = 'x';
                    $tok  = 'x';
                }
                $self->complain("x operator in hash key\n");
            }
            else {

                # git #18
                $type = 'w';
                $self->error_if_expecting_OPERATOR();
            }
        }

        # quote a bare word within braces..like xxx->{s}; note that we
        # must be sure this is not a structural brace, to avoid
        # mistaking {s} in the following for a quoted bare word:
        #     for(@[){s}bla}BLA}
        # Also treat q in something like var{-q} as a bare word, not
        # a quote operator
        elsif (
            $next_nonblank_token eq '}'
            && (
                $last_nonblank_type eq 'L'
                || (   $last_nonblank_type eq 'm'
                    && $last_last_nonblank_type eq 'L' )
            )
          )
        {
            $type = 'w';
        }

        # handle operator x (now we know it isn't $x=)
        elsif (
               $expecting == OPERATOR
            && substr( $tok, 0, 1 ) eq 'x'
            && ( length($tok) == 1
                || substr( $tok, 1, 1 ) =~ /^\d/ )
          )
        {
            $self->do_X_OPERATOR();
        }
        elsif ( $tok_kw eq 'CORE::' ) {
            $type = $tok = $tok_kw;
            $i += 2;
        }
        elsif ( ( $tok eq 'strict' )
            and ( $last_nonblank_token eq 'use' ) )
        {
            $self->[_saw_use_strict_] = 1;
            $self->scan_bare_identifier();
        }

        elsif ( ( $tok eq 'warnings' )
            and ( $last_nonblank_token eq 'use' ) )
        {
            $self->[_saw_perl_dash_w_] = 1;

            # scan as identifier, so that we pick up something like:
            # use warnings::register
            $self->scan_bare_identifier();
        }

        elsif (
               $tok eq 'AutoLoader'
            && $self->[_look_for_autoloader_]
            && (
                $last_nonblank_token eq 'use'

                # these regexes are from AutoSplit.pm, which we want
                # to mimic
                || $input_line =~ /^\s*(use|require)\s+AutoLoader\b/
                || $input_line =~ /\bISA\s*=.*\bAutoLoader\b/
            )
          )
        {
            $self->write_logfile_entry("AutoLoader seen, -nlal deactivates\n");
            $self->[_saw_autoloader_]      = 1;
            $self->[_look_for_autoloader_] = 0;
            $self->scan_bare_identifier();
        }

        elsif (
               $tok eq 'SelfLoader'
            && $self->[_look_for_selfloader_]
            && (   $last_nonblank_token eq 'use'
                || $input_line =~ /^\s*(use|require)\s+SelfLoader\b/
                || $input_line =~ /\bISA\s*=.*\bSelfLoader\b/ )
          )
        {
            $self->write_logfile_entry("SelfLoader seen, -nlsl deactivates\n");
            $self->[_saw_selfloader_]      = 1;
            $self->[_look_for_selfloader_] = 0;
            $self->scan_bare_identifier();
        }

        elsif ( ( $tok eq 'constant' )
            and ( $last_nonblank_token eq 'use' ) )
        {
            $self->do_USE_CONSTANT();
        }

        # Lexical sub names override keywords, labels.  Based on testing,
        # this seems to be the correct location for this check.
        elsif ($is_lexical_sub_type) {
            $type = $is_lexical_sub_type;
        }

        # various quote operators
        elsif ( $is_q_qq_qw_qx_qr_s_y_tr_m{$tok} ) {
            $self->do_QUOTE_OPERATOR();
        }

        # check for a statement label
        elsif (
               ( $next_nonblank_token eq ':' )
            && !$is_not_label
            && ( $rtokens->[ $i_next + 1 ] ne ':' )
            && ( $i_next <= $max_token_index )    # colon on same line

            # like 'sub : lvalue' ?
            && !$self->sub_attribute_ok_here( $tok_kw, $next_nonblank_token,
                $i_next )
            && new_statement_ok()
          )
        {
            if ( $tok !~ /[A-Z]/ ) {
                push @{ $self->[_rlower_case_labels_at_] }, $input_line_number;
            }
            $type = 'J';
            $tok .= ':';
            $i = $i_next;
        }

        # 'sub' or other sub alias
        elsif ( $is_sub{$tok_kw} ) {

            # Guess what to do for unknown word 'method':
            # Updated for --use-feature=class (rt145706):
            if (   $tok_kw eq 'method'
                && $guess_if_method
                && !$self->method_ok_here($next_nonblank_token) )
            {
                $self->do_UNKNOWN_BAREWORD($next_nonblank_token);
            }
            else {
                $self->error_if_expecting_OPERATOR()
                  if ( $expecting == OPERATOR );
                initialize_subname();
                $self->scan_id();
            }
        }

        # 'package'
        elsif ( $is_package{$tok_kw} ) {

            # Update for --use-feature=class (rt145706):
            # We have to be extra careful because 'class' may be used for other
            # purposes on older code; i.e.
            #   class($x)   - valid sub call
            #   package($x) - error
            if ( $tok_kw eq 'class' ) {
                if (   $expecting == OPERATOR
                    || $next_nonblank_token !~ /^[\w\:]/
                    || !$self->class_ok_here() )
                {
                    $self->do_UNKNOWN_BAREWORD($next_nonblank_token);
                }
                else { $self->scan_id() }
            }
            else {
                $self->error_if_expecting_OPERATOR()
                  if ( $expecting == OPERATOR );
                $self->scan_id();
            }
        }

        # Fix for c035: split 'format' from 'is_format_END_DATA' to be
        # more restrictive. Require a new statement to be ok here.
        elsif ( $tok_kw eq 'format' && new_statement_ok() ) {
            $type                = ';';    # make tokenizer look for TERM next
            $self->[_in_format_] = 1;
            $is_last             = 1;      ## is last token on this line
        }

        # Note on token types for format, __DATA__, __END__:
        # It simplifies things to give these type ';', so that when we
        # start rescanning we will be expecting a token of type TERM.
        # We will switch to type 'k' before outputting the tokens.
        elsif ( defined( $is_END_DATA{$tok_kw} ) ) {

            # Warn if this follows an operator expecting a term (c565)
            $self->error_if_expecting_TERM()
              if ( $expecting == TERM );

            $type = ';';    # make tokenizer look for TERM next

            # Remember that we are in one of these three sections
            $self->[ $is_END_DATA{$tok_kw} ] = 1;
            $is_last = 1;                          ## is last token on this line
        }
        elsif ( $is_keyword{$tok_kw} ) {
            $self->do_KEYWORD();
        }

        # check for inline label following
        #         /^(redo|last|next|goto)$/
        elsif (( $last_nonblank_type eq 'k' )
            && ( $is_redo_last_next_goto{$last_nonblank_token} ) )
        {
            $type = 'j';
        }

        # something else --
        else {
            $self->do_UNKNOWN_BAREWORD($next_nonblank_token);
        }

        #----------------------------------------------------------------
        # Save info for use in later guessing. Even for types 'i' and 'U'
        # because those may be marked as type 'w' (barewords) elsewhere.
        #----------------------------------------------------------------
        if (   $is_wiUC{$type}
            && $statement_type ne 'use'
            && $statement_type ne '_use' )
        {
            my $result = "unknown";

            # Words are marked 'function' if they appear in a role which
            # is not consistent with a constant value. Typically they are
            # function calls.
            if (   $type eq 'U'
                || $is_function_follower{$next_nonblank_token} )
            {

                my $empty_parens = 0;
                if ( $next_nonblank_token eq '(' && $i_next < $max_token_index )
                {
                    my $tok_next_p1 = $rtokens->[ $i_next + 1 ];
                    if ( substr( $tok_next_p1, 0, 1 ) eq SPACE
                        && $i_next + 2 <= $max_token_index )
                    {
                        $tok_next_p1 = $rtokens->[ $i_next + 2 ];
                    }
                    $empty_parens = $tok_next_p1 eq ')';
                }

                if ( !$empty_parens ) {

                    # not a constant term - probably a function
                    $result = "function";
                    $self->saw_bareword_function($tok);
                }
            }

            # Words are marked 'constant' if they appear in a role
            # consistent with a constant value.  However, they may simply
            # be functions which optionally take zero args. So if a word
            # appears as both constant and function, it is not a constant.
            elsif ($type eq 'C'
                || $is_constant_follower{$next_nonblank_token} )
            {

                my $is_hash_key = $next_nonblank_token eq '}'
                  && (
                    $last_nonblank_type eq 'L'
                    || (   $last_nonblank_type eq 'm'
                        && $last_last_nonblank_type eq 'L' )
                  );

                if (

                    # not a hash key like {bareword} or {-bareword}
                    !$is_hash_key

                    # not a package name, etc
                    && ( $last_nonblank_type ne 'k'
                        || !$is_use_require_no{$last_nonblank_token} )

                    # skip arrow calls, which can go either way
                    && $last_nonblank_token ne '->'
                  )
                {
                    # possibly a constant or constant function
                    $result = "constant";
                    $self->saw_bareword_constant($tok);
                }
                else {
                    $result = "other bareword";
                }
            }
            else {
                ## something else
            }

            if ( DEBUG_BAREWORD && $result ne 'other bareword' ) {
                print
"$input_line_number: $result: $tok: type=$type : last_tok=$last_nonblank_token : next_tok='$next_nonblank_token'\n";
            }
        }
        return $is_last;

    } ## end sub do_BAREWORD

    # Table of quote types checked for interpolated here targets.
    # Issue 310 has extensive test cases.
    my %is_interpolated_quote = (
        q{'} => 0,
        q{`} => 1,
        q{"} => 1,
        qq   => 1,
        qx   => 1,
        m    => 1,
        qr   => 1,
        q    => 0,
        qw   => 0,
        s    => 1,
        y    => 0,
        tr   => 0,
    );

    sub push_here_targets {
        my ($rht) = @_;

        # Push here targets found in a quote onto the here target list
        push @{$rhere_target_list}, @{$rht};

        # Change type from 'Q' to 'h' for quotes with here-doc targets so that
        # the formatter (see sub process_line_of_CODE) will not make any line
        # breaks after this point.
        $type = 'h';
        if ( $i_tok < 0 ) {
            my $ilast = $routput_token_list->[-1];
            $routput_token_type->[$ilast] = $type;
        }
        return;
    } ## end sub push_here_targets

    sub do_FOLLOW_QUOTE {

        my $self = shift;

        # Continue following a quote on a new line
        $type = $quote_type;

        # initialize if continuation line
        if ( !@{$routput_token_list} ) {
            push( @{$routput_token_list}, $i );
            $routput_token_type->[$i] = $type;
        }

        # Save starting lengths for here target search
        my $len_qs1        = length($quoted_string_1);
        my $len_qs2        = length($quoted_string_2);
        my $in_quote_start = $in_quote;

        # scan for the end of the quote or pattern
        (
            $i,
            $in_quote,
            $quote_character,
            $quote_pos,
            $quote_depth,
            $quoted_string_1,
            $quoted_string_2,

        ) = $self->do_quote(

            $i,
            $in_quote,
            $quote_character,
            $quote_pos,
            $quote_depth,
            $quoted_string_1,
            $quoted_string_2,
            $rtokens,
            $rtoken_type,
            $rtoken_map,
            $max_token_index,

        );

        # Save pattern and replacement text for rescanning for /e
        my $qs1_for_e_scan = $quoted_string_1;

        # Check for possible here targets in an interpolated quote
        if (   $is_interpolated_quote{$quote_starting_tok}
            && $in_quote < $in_quote_start )
        {

            # post any saved target of a 2-part quote if the end is reached
            if ( !$in_quote && defined($quote_here_target_2) ) {

                # Safety check
                if ( $quote_items{$quote_starting_tok} == 2 ) {
                    push_here_targets($quote_here_target_2);
                }
                else {
                    DEVEL_MODE
                      && Fault(
"unexpected saved here target near line $input_line_number\n"
                      );
                }
                $quote_here_target_2 = undef;
            }

            # Single part quotes: use $quoted_string_1, and
            #  $in_quote drops from 1 to 0 when the end is found
            # Dual part quotes ('s'): first part is in $quoted_string_2, and
            #  $in_quote:
            #    drops from 2 to 1 when the the first part is found
            #    drops 1 to 0 when the the second part is found
            #    drops from 2 to 0 if both parts are found in this call
            # The tricky part is that we must search for here targets whenever
            # $in_quote drops, but we can only post here targets after the end
            # of the last part is found (in_quote==0). See test 'here4.in'.
            # Update c310 added interpolated here docs and has many test cases.

            # Initialize for the normal case of a single quote
            my $qs         = $quoted_string_1;
            my $len_qs     = $len_qs1;
            my $num_quotes = $in_quote_start - $in_quote;

            # Dual part quotes (type 's') have first part in $quoted_string_2
            if ( $in_quote_start == 2 ) {
                $qs     = $quoted_string_2;
                $len_qs = $len_qs2;
            }

            # Loop to search 1 or 2 quotes for here targets
            foreach ( 1 .. $num_quotes ) {

                # Perform quick tests to avoid a sub call:
                my $pos_shift = rindex( $qs, '<<' );
                if (

                    # a '<<' in the last line
                    $pos_shift >= $len_qs

                    # and a '}' in the last line (c598: updated to allow
                    # for the possibility of an extra '<<' after a here doc)
                    && rindex( $qs, '}' ) >= $len_qs

                    # and a '<<' preceded by '$' or '@'
                    && (   rindex( $qs, '$', $pos_shift ) >= 0
                        || rindex( $qs, '@', $pos_shift ) >= 0 )
                  )
                {

                    # scan the quote for here targets
                    my ( $rht, $qs_mod ) =
                      $self->find_interpolated_here_targets( $qs, $len_qs );
                    if ($rht) {

                        # only post here targets when end of quote is found
                        if ($in_quote) {
                            $quote_here_target_2 = $rht;
                        }
                        else {
                            push_here_targets($rht);

                            # Replace the string with the modified version
                            # in case it is re-scanned due to a /e modifier
                            $qs1_for_e_scan = $qs_mod;
                        }
                    }
                }

                # re-initialize for next pass
                $qs     = $quoted_string_1;
                $len_qs = $len_qs1;
            } ## end while ( $num_quotes-- > 0)
        }

        if ($in_quote) { return }

        # All done with this quote...

        # re-initialize for next search
        $quote_character = EMPTY_STRING;
        $quote_pos       = 0;
        $quote_type      = 'Q';
        $quoted_string_1 = EMPTY_STRING;
        $quoted_string_2 = EMPTY_STRING;
        if ( ++$i > $max_token_index ) { return }

        # look for any modifiers
        if ($allowed_quote_modifiers) {

            # check for exact quote modifiers
            if ( $rtokens->[$i] =~ /^[A-Za-z_]/ ) {
                my $str = $rtokens->[$i];
                my $saw_modifier_e;
                while ( $str =~ /\G$allowed_quote_modifiers/gc ) {
                    my $pos  = pos($str);
                    my $char = substr( $str, $pos - 1, 1 );
                    $saw_modifier_e ||= ( $char eq 'e' );
                }

                # For an 'e' quote modifier we must scan the replacement
                # text for here-doc targets...
                # but if the modifier starts a new line we must skip
                # this because either the here doc will be fully
                # contained in the replacement text (so we can
                # ignore it) or Perl will not find it. The modifier will have a
                # pretoken index $i=1 if it starts a new line, so we only look
                # for a here doc if $i>1.  See test 'here2.in'.
                if ( $saw_modifier_e && $i > 1 ) {
                    my $rht = $self->scan_replacement_text($qs1_for_e_scan);
                    if ($rht) {
                        push_here_targets($rht);
                    }
                }

                if ( defined( pos($str) ) ) {

                    # matched
                    if ( pos($str) == length($str) ) {
                        if ( ++$i > $max_token_index ) { return }
                    }

                    # Looks like a joined quote modifier
                    # and keyword, maybe something like
                    # s/xxx/yyy/gefor @k=...
                    # Example is "galgen.pl".  Would have to split
                    # the word and insert a new token in the
                    # pre-token list.  This is so rare that I haven't
                    # done it.  Will just issue a warning citation.

                    # This error might also be triggered if my quote
                    # modifier characters are incomplete
                    else {
                        $self->warning(<<EOM);

Partial match to quote modifier $allowed_quote_modifiers at word: '$str'
Please put a space between quote modifiers and trailing keywords.
EOM

                        # print "token $rtokens->[$i]\n";
                        # my $num = length($str) - pos($str);
                        # $rtokens->[$i]=substr($rtokens->[$i],pos($str),$num);
                        # print "continuing with new token $rtokens->[$i]\n";

                        # skipping past this token does least damage
                        if ( ++$i > $max_token_index ) { return }
                    }
                }
                else {

                    # example file: rokicki4.pl
                    # This error might also be triggered if my quote
                    # modifier characters are incomplete
                    $self->write_logfile_entry(
                        "Note: found word $str at quote modifier location\n");
                }
            }

            # re-initialize
            $allowed_quote_modifiers = EMPTY_STRING;
        }
        return;
    } ## end sub do_FOLLOW_QUOTE

    # ------------------------------------------------------------
    # begin hash of code for handling most token types
    # ------------------------------------------------------------
    my $tokenization_code = {

        '$'   => \&do_DOLLAR_SIGN,
        '('   => \&do_LEFT_PARENTHESIS,
        ')'   => \&do_RIGHT_PARENTHESIS,
        ','   => \&do_COMMA,
        ';'   => \&do_SEMICOLON,
        '"'   => \&do_QUOTATION_MARK,
        "'"   => \&do_APOSTROPHE,
        '`'   => \&do_BACKTICK,
        '/'   => \&do_SLASH,
        '{'   => \&do_LEFT_CURLY_BRACKET,
        '}'   => \&do_RIGHT_CURLY_BRACKET,
        '&'   => \&do_AMPERSAND,
        '<'   => \&do_LESS_THAN_SIGN,
        '?'   => \&do_QUESTION_MARK,
        '*'   => \&do_STAR,
        '.'   => \&do_DOT,
        ':'   => \&do_COLON,
        '+'   => \&do_PLUS_SIGN,
        '@'   => \&do_AT_SIGN,
        '%'   => \&do_PERCENT_SIGN,
        '['   => \&do_LEFT_SQUARE_BRACKET,
        ']'   => \&do_RIGHT_SQUARE_BRACKET,
        '-'   => \&do_MINUS_SIGN,
        '^'   => \&do_CARAT_SIGN,
        '::'  => \&do_DOUBLE_COLON,
        '<<'  => \&do_LEFT_SHIFT,
        '<<~' => \&do_NEW_HERE_DOC,
        '->'  => \&do_POINTER,
        '++'  => \&do_PLUS_PLUS,
        '=>'  => \&do_FAT_COMMA,
        '--'  => \&do_MINUS_MINUS,

        # No special code for these types yet, but syntax checks
        # could be added.
        ##  '&&'  => \&do_LOGICAL_AND,
        ##  '||'  => \&do_LOGICAL_OR,
        ##  '>'   => \&do_GREATER_THAN_SIGN,
        ##  '|'   => \&do_VERTICAL_LINE,
        ##  '//'  => \&do_SLASH_SLASH,
        ##  '!'   => undef,
        ##  '!='  => undef,
        ##  '!~'  => undef,
        ##  '%='  => undef,
        ##  '&&=' => undef,
        ##  '&='  => undef,
        ##  '+='  => undef,
        ##  '-='  => undef,
        ##  '..'  => undef,
        ##  '..'  => undef,
        ##  '...' => undef,
        ##  '.='  => undef,
        ##  '<<=' => undef,
        ##  '<='  => undef,
        ##  '<=>' => undef,
        ##  '<>'  => undef,
        ##  '='   => undef,
        ##  '=='  => undef,
        ##  '=~'  => undef,
        ##  '>='  => undef,
        ##  '>>'  => undef,
        ##  '>>=' => undef,
        ##  '\\'  => undef,
        ##  '^='  => undef,
        ##  '|='  => undef,
        ##  '||=' => undef,
        ##  '//=' => undef,
        ##  '~'   => undef,
        ##  '~~'  => undef,
        ##  '!~~' => undef,

    };

    # ------------------------------------------------------------
    # end hash of code for handling individual token types
    # ------------------------------------------------------------

    use constant DEBUG_TOKENIZE => 0;

    my %is_arrow_or_Z;

    BEGIN {
        my @qZ = qw( -> Z );
        $is_arrow_or_Z{$_} = 1 for @qZ;
    }

    sub tokenize_this_line {

        my ( $self, $line_of_tokens, $trimmed_input_line ) = @_;

        # This routine tokenizes one line. The results are stored in
        # the hash ref '$line_of_tokens'.

        # Given:
        #   $line_of_tokens = ref to hash of values being filled for this line
        #   $trimmed_input_line
        #        = the input line without leading whitespace, OR
        #        = undef if not available
        # Returns:
        #   nothing

        my $untrimmed_input_line = $line_of_tokens->{_line_text};

        # Extract line number for use in error messages
        $input_line_number = $line_of_tokens->{_line_number};

        #-------------------------------------
        # Check for start of pod documentation
        #-------------------------------------
        if (   !$in_quote
            && substr( $untrimmed_input_line, 0, 1 ) eq '='
            && $untrimmed_input_line =~ /^=[A-Za-z_]/ )
        {

            # Must not be in an equation where an '=' could be expected.
            # Perl has additional restrictions which are not checked here.
            my $blank_after_Z = 1;
            $expecting = $self->operator_expected( '=', 'b', $blank_after_Z );
            if ( $expecting == TERM ) {
                $self->[_in_pod_] = 1;
                return;
            }
        }

        #--------------------------
        # Trim leading whitespace ?
        #--------------------------
        # Use untrimmed line if we are continuing in a type 'Q' quote
        if ( $in_quote && $quote_type eq 'Q' ) {
            $line_of_tokens->{_starting_in_quote} = 1;
            $input_line = $untrimmed_input_line;
            chomp $input_line;
        }

        # Trim start of this line if we are not continuing a quoted line.
        # Do not trim end because we might end in a quote (test: deken4.pl)
        # Perl::Tidy::Formatter will delete needless trailing blanks
        else {
            $line_of_tokens->{_starting_in_quote} = 0;

            # Use the pre-computed trimmed line if defined (most efficient)
            $input_line = $trimmed_input_line;

            # otherwise trim the raw input line (much less efficient)
            if ( !defined($input_line) ) {
                $input_line = $untrimmed_input_line;
                $input_line =~ s/^\s+//;
            }

            chomp $input_line;

            # define 'guessed_indentation_level' if logfile will be saved
            if ( $self->[_save_logfile_] && length($input_line) ) {
                my $guess =
                  $self->guess_old_indentation_level($untrimmed_input_line);
                $line_of_tokens->{_guessed_indentation_level} = $guess;
            }
        }

        #------------
        # Blank lines
        #------------
        if ( !length($input_line) ) {
            $line_of_tokens->{_line_type}        = 'CODE';
            $line_of_tokens->{_rtokens}          = [];
            $line_of_tokens->{_rtoken_type}      = [];
            $line_of_tokens->{_rlevels}          = [];
            $line_of_tokens->{_rblock_type}      = [];
            $line_of_tokens->{_nesting_tokens_0} = $nesting_token_string;
            $line_of_tokens->{_nesting_blocks_0} = $nesting_block_string;
            return;
        }

        #---------
        # Comments
        #---------
        if ( !$in_quote && substr( $input_line, 0, 1 ) eq '#' ) {

            # and check for skipped section
            if (
                (
                    substr( $input_line, 0, 4 ) eq '#<<V'
                    || $rOpts_code_skipping_begin
                )
                && $rOpts_code_skipping

                # note that the code_skipping_patterns require a newline
                && ( $input_line . SPACE ) =~ /$code_skipping_pattern_begin/
              )
            {
                $self->[_in_code_skipping_] = $self->[_last_line_number_];
                return;
            }

            # Look for format skipping tags, but just normal mode.
            # It will be used for these purposes:
            # - to inform the formatter of an end token with no begin token
            # - for making a hint when a brace error is detected
            if (
                (
                    substr( $input_line, 0, 4 ) eq '#<<<'
                    || $rOpts_format_skipping_begin
                )
                && $rOpts_format_skipping

                # note that the format_skipping_patterns require a space
                && ( $input_line . SPACE ) =~ /$format_skipping_pattern_begin/

                # allow same token for begin and end
                && (
                    !$self->[_in_format_skipping_]
                    || ( $format_skipping_pattern_begin ne
                        $format_skipping_pattern_end )
                )
              )
            {
                my $on_off                = 1;
                my $lno                   = $self->[_last_line_number_];
                my $rformat_skipping_list = $self->[_rformat_skipping_list_];

                # format markers must alternate between on and off
                if ( @{$rformat_skipping_list}
                    && $rformat_skipping_list->[-1]->[0] == $on_off )
                {
                    my $lno_last = $rformat_skipping_list->[-1]->[1];
                    $self->warning_do_not_format(
"consecutive format-skipping start markers - see line $lno_last\n"
                    );
                }
                push @{$rformat_skipping_list}, [ $on_off, $lno, $input_line ];
                $self->[_in_format_skipping_] = $lno;
            }
            elsif (
                (
                    substr( $input_line, 0, 4 ) eq '#>>>'
                    || $rOpts_format_skipping_end
                )
                && $rOpts_format_skipping

                # note that the format_skipping_patterns require a newline
                && ( $input_line . SPACE ) =~ /$format_skipping_pattern_end/
              )
            {
                my $lno                   = $self->[_last_line_number_];
                my $rformat_skipping_list = $self->[_rformat_skipping_list_];
                my $on_off                = -1;

                # markers must alternate between on and off
                if ( @{$rformat_skipping_list}
                    && $rformat_skipping_list->[-1]->[0] == $on_off )
                {
                    my $lno_last = $rformat_skipping_list->[-1]->[1];
                    $self->warning_do_not_format(
"consecutive format-skipping end markers - see line $lno_last\n"
                    );
                }

                push @{$rformat_skipping_list}, [ $on_off, $lno, $input_line ];
                $self->[_in_format_skipping_] = 0;
            }
            else {
                ## not a format skipping comment
            }

            # Optional fast processing of a block comment
            $line_of_tokens->{_line_type}        = 'CODE';
            $line_of_tokens->{_rtokens}          = [$input_line];
            $line_of_tokens->{_rtoken_type}      = ['#'];
            $line_of_tokens->{_rlevels}          = [$level_in_tokenizer];
            $line_of_tokens->{_rblock_type}      = [EMPTY_STRING];
            $line_of_tokens->{_nesting_tokens_0} = $nesting_token_string;
            $line_of_tokens->{_nesting_blocks_0} = $nesting_block_string;
            return;
        }

        #-------------------------------------
        # Loop to find all tokens on this line
        #-------------------------------------

        # Update the copy of the line for use in error messages
        # This must be exactly what we give the pre_tokenizer
        $self->[_line_of_text_] = $input_line;

        # re-initialize for the main loop
        $routput_token_list    = [];    # stack of output token indexes
        $routput_token_type    = [];    # token types
        $routput_block_type    = [];    # types of code block
        $routput_type_sequence = [];    # nesting sequential number

        $rhere_target_list = [];

        $tok             = $last_nonblank_token;
        $type            = $last_nonblank_type;
        $prototype       = $last_nonblank_prototype;
        $last_nonblank_i = -1;
        $block_type      = $last_nonblank_block_type;
        $container_type  = $last_nonblank_container_type;
        $type_sequence   = $last_nonblank_type_sequence;
        $indent_flag     = 0;
        $peeked_ahead    = 0;

        $self->tokenizer_main_loop();

        #-------------------------------------------------
        # Done tokenizing this line ... package the result
        #-------------------------------------------------
        $self->tokenizer_wrapup_line($line_of_tokens);

        return;
    } ## end sub tokenize_this_line

    sub tokenizer_main_loop {

        my ($self) = @_;

        # Break one input line into tokens
        # We are working on closure variables.

        # Start by breaking the line into pre-tokens
        ( $rtokens, $rtoken_map, $rtoken_type ) = pre_tokenize($input_line);

        # Verify that all leading whitespace has been trimmed
        # except for quotes of type 'Q' (c273).
        if (   @{$rtokens}
            && $rtoken_type->[0] eq 'b'
            && !( $in_quote && $quote_type eq 'Q' ) )
        {

            # Shouldn't happen if calling sub did trim operation correctly.
            DEVEL_MODE && Fault(<<EOM);
leading blank at line
$input_line
EOM

            # Fix by removing the leading blank token.  This fix has been
            # tested and works correctly even if no whitespaces was trimmed.
            # But it is an inefficient way to do things because, for example,
            # it forces all comments to be processed by sub pre_tokenize.
            # And it may cause indented code-skipping comments to be missed.
            shift @{$rtokens};
            shift @{$rtoken_map};
            shift @{$rtoken_type};
        }

        $max_token_index = scalar( @{$rtokens} ) - 1;
        push( @{$rtokens}, SPACE, SPACE, SPACE )
          ;    # extra whitespace simplifies logic
        push( @{$rtoken_map},  0,   0,   0 );     # shouldn't be referenced
        push( @{$rtoken_type}, 'b', 'b', 'b' );

        # initialize for main loop
        if (0) { #<<< this is not necessary
        foreach my $ii ( 0 .. $max_token_index + 3 ) {
            $routput_token_type->[$ii]    = EMPTY_STRING;
            $routput_block_type->[$ii]    = EMPTY_STRING;
            $routput_type_sequence->[$ii] = EMPTY_STRING;
            $routput_indent_flag->[$ii]   = 0;
        }
        }

        $i     = -1;
        $i_tok = -1;

        #-----------------------
        # main tokenization loop
        #-----------------------

        # we are looking at each pre-token of one line and combining them
        # into tokens
        while ( ++$i <= $max_token_index ) {

            # continue looking for the end of a quote
            if ($in_quote) {
                $self->do_FOLLOW_QUOTE();
                last if ( $in_quote || $i > $max_token_index );
            }

            if ( $type ne 'b' && $type ne 'CORE::' ) {

                # try to catch some common errors
                if ( ( $type eq 'n' ) && ( $tok ne '0' ) ) {

                    if ( $last_nonblank_token eq 'eq' ) {
                        $self->complain("Should 'eq' be '==' here ?\n");
                    }
                    elsif ( $last_nonblank_token eq 'ne' ) {
                        $self->complain("Should 'ne' be '!=' here ?\n");
                    }
                    else {
                        ## that's all
                    }
                }

                # fix c090, only rotate vars if a new token will be stored
                if ( $i_tok >= 0 ) {

                    $last_last_nonblank_token = $last_nonblank_token;
                    $last_last_nonblank_type  = $last_nonblank_type;

                    $last_nonblank_prototype      = $prototype;
                    $last_nonblank_block_type     = $block_type;
                    $last_nonblank_container_type = $container_type;
                    $last_nonblank_type_sequence  = $type_sequence;
                    $last_nonblank_i              = $i_tok;
                    $last_nonblank_token          = $tok;
                    $last_nonblank_type           = $type;
                }

                # Check for patches
                if ( $is_arrow_or_Z{$last_last_nonblank_type} ) {

                    # Patch for c030: Fix things in case a '->' got separated
                    # from the subsequent identifier by a side comment.  We
                    # need the last_nonblank_token to have a leading -> to
                    # avoid triggering an operator expected error message at
                    # the next '('. See also fix for git #63.
                    if ( $last_last_nonblank_type eq '->' ) {
                        if (   $last_nonblank_type eq 'w'
                            || $last_nonblank_type eq 'i' )
                        {
                            $last_nonblank_token = '->' . $last_nonblank_token;
                            $last_nonblank_type  = 'i';
                        }
                    }

                    # Fix part #3 for git82: propagate type 'Z' though L-R pair
                    elsif ( $last_last_nonblank_type eq 'Z' ) {
                        if ( $last_nonblank_type eq 'R' ) {
                            $last_nonblank_type  = $last_last_nonblank_type;
                            $last_nonblank_token = $last_last_nonblank_token;
                        }
                    }
                    else {
                        ## No other patches
                    }
                }
            }

            # store previous token type
            if ( $i_tok >= 0 ) {
                $routput_token_type->[$i_tok]    = $type;
                $routput_block_type->[$i_tok]    = $block_type;
                $routput_type_sequence->[$i_tok] = $type_sequence;
                $routput_indent_flag->[$i_tok]   = $indent_flag;
            }

            # get the next pre-token and type
            # $tok and $type will be modified to make the output token
            my $pre_tok  = $tok  = $rtokens->[$i];      # get the next pre-token
            my $pre_type = $type = $rtoken_type->[$i];  # and type

            # re-initialize various flags for the next output token
            (

                # remember the starting index of this token; we will update $i
                $i_tok,
                $block_type,
                $container_type,
                $type_sequence,
                $indent_flag,
                $prototype,
              )
              = (

                $i,
                EMPTY_STRING,
                EMPTY_STRING,
                EMPTY_STRING,
                0,
                EMPTY_STRING,
              );

            # this pre-token will start an output token
            push( @{$routput_token_list}, $i_tok );

            #---------------------------------------------------
            # The token search leads to one of 5 main END NODES:
            #---------------------------------------------------

            #-----------------------
            # END NODE 1: whitespace
            #-----------------------
            next if ( $pre_type eq 'b' );

            #----------------------
            # END NODE 2: a comment
            #----------------------
            if ( $pre_type eq '#' ) {

                # push non-indenting brace stack Look for a possible
                # non-indenting brace.  This is only used to give a hint in
                # case the file is unbalanced.
                # Hardwired to '#<<<' for efficiency.  We will not use the
                # result later if the pattern has been changed (very unusual).
                if (   $last_nonblank_token eq '{'
                    && $last_nonblank_block_type
                    && $last_nonblank_type_sequence
                    && !$self->[_in_format_skipping_]
                    && $rOpts_non_indenting_braces )
                {
                    my $offset = $rtoken_map->[$i_tok];
                    my $text   = substr( $input_line, $offset, 5 );
                    my $len    = length($text);
                    if (   $len == 4 && $text eq '#<<<'
                        || $len > 4 && $text eq '#<<< ' )
                    {
                        push @{ $self->[_rnon_indenting_brace_stack_] },
                          $last_nonblank_type_sequence;
                    }
                }
                last;
            }

            # continue gathering identifier if necessary
            if ($id_scan_state) {

                if ( $is_sub{$id_scan_state} || $is_package{$id_scan_state} ) {
                    $self->scan_id();
                }
                else {
                    $self->scan_identifier();
                }

                if ($id_scan_state) {

                    # Still scanning ...
                    # Check for side comment between sub and prototype (c061)

                    # done if nothing left to scan on this line
                    last if ( $i > $max_token_index );

                    my ( $next_nonblank_token_uu, $i_next ) =
                      find_next_nonblank_token_on_this_line( $i, $rtokens,
                        $max_token_index );

                    # done if it was just some trailing space
                    last if ( $i_next > $max_token_index );

                    # something remains on the line ... must be a side comment
                    next;
                }

                next if ( ( $i > 0 ) || $type );

                # didn't find any token; start over
                $type = $pre_type;
                $tok  = $pre_tok;
            }

            #-----------------------------------------------------------
            # Combine pre-tokens into digraphs and trigraphs if possible
            #-----------------------------------------------------------

            # See if we can make a digraph...
            # The following tokens are excluded and handled specially:
            # '/=' is excluded because the / might start a pattern.
            # 'x=' is excluded since it might be $x=, with $ on previous line
            # '**' and *= might be typeglobs of punctuation variables
            # I have allowed tokens starting with <, such as <=,
            # because I don't think these could be valid angle operators.
            # test file: storrs4.pl
            if (   $can_start_digraph{$tok}
                && $i < $max_token_index
                && $is_digraph{ $tok . $rtokens->[ $i + 1 ] } )
            {

                my $combine_ok = 1;
                my $test_tok   = $tok . $rtokens->[ $i + 1 ];

                # check for special cases which cannot be combined

                # Smartmatch is being deprecated, but may exist in older
                # scripts.
                if ( $test_tok eq '~~' ) {

                    # Do not combine if a TERM is required
                    if ( $self->operator_expected( $tok, '~', undef ) == TERM )
                    {

                        # block types ';' may actually be hash refs, c567
                        if ( $last_nonblank_type eq '}' ) {
                            my $blk = $rbrace_type->[ $brace_depth + 1 ];
                            if ( !$blk || $blk ne ';' ) { $combine_ok = 0 }
                        }
                        else {
                            $combine_ok = 0;
                        }
                    }
                }

                # '//' must be defined_or operator if an operator is expected.
                # TODO: Code for other ambiguous digraphs (/=, x=, **, *=)
                # could be migrated here for clarity

                # Patch for RT#102371, misparsing a // in the following snippet:
                #     state $b //= ccc();
                # The solution is to always accept the digraph (or trigraph)
                # after type 'Z' (possible file handle).  The reason is that
                # sub operator_expected gives TERM expected here, which is
                # wrong in this case.
                elsif ( $test_tok eq '//' ) {
                    if ( $last_nonblank_type ne 'Z' ) {

                        # note that here $tok = '/' and the next tok and type
                        # is '/'
                        my $blank_after_Z;
                        $expecting =
                          $self->operator_expected( $tok, '/', $blank_after_Z );

                        # Patched for RT#101547, was
                        #   'unless ($expecting==OPERATOR)'
                        $combine_ok = 0 if ( $expecting == TERM );
                    }
                }

                # Patch for RT #114359: mis-parsing of "print $x ** 0.5;
                # Accept the digraphs '**' only after type 'Z'
                # Otherwise postpone the decision.
                elsif ( $test_tok eq '**' ) {
                    if ( $last_nonblank_type ne 'Z' ) { $combine_ok = 0 }
                }
                else {
                    ## no other special cases
                }

                if (

                    # still ok to combine?
                    $combine_ok

                    && ( $test_tok ne '/=' )    # might be pattern
                    && ( $test_tok ne 'x=' )    # might be $x
                    && ( $test_tok ne '*=' )    # typeglob?

                    # Moved above as part of fix for
                    # RT #114359: Missparsing of "print $x ** 0.5;
                    # && ( $test_tok ne '**' )    # typeglob?
                  )
                {
                    $tok = $test_tok;
                    $i++;

                    # Now try to assemble trigraphs.  Note that all possible
                    # perl trigraphs can be constructed by appending a character
                    # to a digraph.
                    $test_tok = $tok . $rtokens->[ $i + 1 ];

                    if ( $is_trigraph{$test_tok} ) {
                        $tok = $test_tok;
                        $i++;
                    }

                    # The only current tetragraph is the double diamond operator
                    # and its first three characters are NOT a trigraph, so
                    # we do can do a special test for it
                    else {
                        if ( $test_tok eq '<<>' ) {
                            $test_tok .= $rtokens->[ $i + 2 ];
                            if ( $is_tetragraph{$test_tok} ) {
                                $tok = $test_tok;
                                $i += 2;
                            }
                        }
                    }
                }
            }

            $type      = $tok;
            $next_tok  = $rtokens->[ $i + 1 ];
            $next_type = $rtoken_type->[ $i + 1 ];

            # expecting an operator here? first try table lookup, then function
            $expecting = $op_expected_table{$last_nonblank_type};
            if ( !defined($expecting) ) {
                my $blank_after_Z = $last_nonblank_type eq 'Z'
                  && ( $i == 0 || $rtoken_type->[ $i - 1 ] eq 'b' );
                $expecting =
                  $self->operator_expected( $tok, $next_type, $blank_after_Z );
            }

            DEBUG_TOKENIZE && do {
                local $LIST_SEPARATOR = ')(';
                my @debug_list = (
                    $last_nonblank_token,         $tok,
                    $next_tok,                    $brace_depth,
                    $rbrace_type->[$brace_depth], $paren_depth,
                    $rparen_type->[$paren_depth],
                );
                print {*STDOUT} "TOKENIZE:(@debug_list)\n";
            };

            # The next token is '$tok'.
            # Now we have to define its '$type'

            #------------------------
            # END NODE 3: a bare word
            #------------------------
            if ( $pre_type eq 'w' ) {
                my $is_last = $self->do_BAREWORD();
                last if ($is_last);
                next;
            }

            # Turn off attribute list on first non-blank, non-bareword,
            # and non-comment (added to fix c038)
            $self->[_in_attribute_list_] = 0;

            #-------------------------------
            # END NODE 4: a string of digits
            #-------------------------------
            if ( $pre_type eq 'd' ) {
                $self->do_DIGITS();
                next;
            }

            #------------------------------------------
            # END NODE 5: everything else (punctuation)
            #------------------------------------------
            my $code = $tokenization_code->{$tok};
            if ($code) {
                $code->($self);
                redo if ($in_quote);
            }

            # Check for a non-TERM where a TERM is expected. Note that this
            # checks all symbols, even those without a $code (update c566)
            if ( $expecting == TERM ) {
                my $is_not_term =
                     $type eq ';'
                  || $type eq ','
                  || $is_binary_operator_type{$type};
                if ($is_not_term) {
                    $self->error_if_expecting_TERM();
                }
            }
        }    ## End main tokenizer loop

        # Store the final token
        if ( $i_tok >= 0 ) {
            $routput_token_type->[$i_tok]    = $type;
            $routput_block_type->[$i_tok]    = $block_type;
            $routput_type_sequence->[$i_tok] = $type_sequence;
            $routput_indent_flag->[$i_tok]   = $indent_flag;
        }

        # Remember last nonblank values
        if ( $type ne 'b' && $type ne '#' ) {

            $last_last_nonblank_token = $last_nonblank_token;
            $last_last_nonblank_type  = $last_nonblank_type;

            $last_nonblank_prototype      = $prototype;
            $last_nonblank_block_type     = $block_type;
            $last_nonblank_container_type = $container_type;
            $last_nonblank_type_sequence  = $type_sequence;
            $last_nonblank_token          = $tok;
            $last_nonblank_type           = $type;
        }

        # reset indentation level if necessary at a sub or package
        # in an attempt to recover from a nesting error
        if ( $level_in_tokenizer < 0 ) {
            if ( $input_line =~ /^\s*(sub|package)\s+(\w+)/ ) {
                reset_indentation_level(0);
                $self->brace_warning("resetting level to 0 at $1 $2\n");
            }
        }

        $self->[_in_quote_] = $in_quote;
        $self->[_quote_target_] =
          $in_quote
          ? (
              $matching_end_token{$quote_character}
            ? $matching_end_token{$quote_character}
            : $quote_character
          )
          : EMPTY_STRING;
        $self->[_rhere_target_list_] = $rhere_target_list;

        return;
    } ## end sub tokenizer_main_loop

    sub tokenizer_wrapup_line {
        my ( $self, $line_of_tokens ) = @_;

        #---------------------------------------------------------
        # Package a line of tokens for shipping back to the caller
        #---------------------------------------------------------

        # Arrays to hold token values for this line:
        my (
            @output_levels,     @output_block_type, @output_type_sequence,
            @output_token_type, @output_tokens,
        );

        $line_of_tokens->{_nesting_tokens_0} = $nesting_token_string;

        # Remember starting nesting block string
        my $nesting_block_string_0 = $nesting_block_string;

        #-----------------
        # Loop over tokens
        #-----------------
        # $i is the index of the pretoken which starts this full token
        foreach my $ii ( @{$routput_token_list} ) {

            my $type_i = $routput_token_type->[$ii];

            #----------------------------------------
            # Section 1. Handle a non-sequenced token
            #----------------------------------------
            if ( !$routput_type_sequence->[$ii] ) {

                #-------------------------------
                # Section 1.1. types ';' and 't'
                #-------------------------------
                # - output anonymous 'sub' as keyword (type 'k')
                # - output __END__, __DATA__, and format as type 'k' instead
                #   of ';' to make html colors correct, etc.
                if ( $is_semicolon_or_t{$type_i} ) {
                    my $tok_i = $rtokens->[$ii];
                    if ( $is_END_DATA_format_sub{$tok_i} ) {
                        $type_i = 'k';
                    }
                }

                #----------------------------------------------
                # Section 1.2. Check for an invalid token type.
                #----------------------------------------------
                # This can happen by running perltidy on non-scripts although
                # it could also be bug introduced by programming change.  Perl
                # silently accepts a 032 (^Z) and takes it as the end
                elsif ( !$is_valid_token_type{$type_i} ) {
                    if ( !$self->[_in_error_] ) {
                        my $val = ord($type_i);
                        $self->warning(
"unexpected character decimal $val ($type_i) in script\n"
                        );
                        $self->[_in_error_] = 1;
                    }
                }
                else {
                    ## valid token type other than ; and t
                }

                #----------------------------------------------------
                # Section 1.3. Store values for a non-sequenced token
                #----------------------------------------------------
                push( @output_levels,        $level_in_tokenizer );
                push( @output_block_type,    EMPTY_STRING );
                push( @output_type_sequence, EMPTY_STRING );
                push( @output_token_type,    $type_i );

            }

            #------------------------------------
            # Section 2. Handle a sequenced token
            #    One of { [ ( ? : ) ] }
            #------------------------------------
            else {

                # $level_i is the level we will store.  Levels of braces are
                # set so that the leading braces have a HIGHER level than their
                # CONTENTS, which is convenient for indentation.
                my $level_i = $level_in_tokenizer;

                # $tok_i is the PRE-token.  It only equals the token for symbols
                my $tok_i = $rtokens->[$ii];

                # $routput_indent_flag->[$ii] indicates that we need a change
                # in level at a nested ternary, as follows
                #     1 => at a nested ternary ?
                #    -1 => at a nested ternary :
                #     0 => otherwise

                #--------------------------------------------
                # Section 2.1 Handle a level-increasing token
                #--------------------------------------------
                if ( $is_opening_or_ternary_type{$type_i} ) {

                    if ( $type_i eq '?' ) {

                        if ( $routput_indent_flag->[$ii] > 0 ) {
                            $level_in_tokenizer++;

                            # break BEFORE '?' in a nested ternary
                            $level_i = $level_in_tokenizer;
                            $nesting_block_string .= "$nesting_block_flag";

                        }
                    }
                    else {

                        $nesting_token_string .= $tok_i;

                        if ( $type_i eq '{' || $type_i eq 'L' ) {

                            $level_in_tokenizer++;

                            if ( $routput_block_type->[$ii] ) {
                                $nesting_block_flag = 1;
                                $nesting_block_string .= '1';
                            }
                            else {
                                $nesting_block_flag = 0;
                                $nesting_block_string .= '0';
                            }
                        }
                    }
                }

                #---------------------------------------------
                # Section 2.2. Handle a level-decreasing token
                #---------------------------------------------
                elsif ( $is_closing_or_ternary_type{$type_i} ) {

                    if ( $type_i ne ':' ) {
                        my $char = chop $nesting_token_string;
                        if ( $char ne $matching_start_token{$tok_i} ) {
                            $nesting_token_string .= $char . $tok_i;
                        }
                    }

                    if (
                           $type_i eq '}'
                        || $type_i eq 'R'

                        # only the second and higher ? : have levels
                        || $type_i eq ':' && $routput_indent_flag->[$ii] < 0
                      )
                    {

                        $level_i = --$level_in_tokenizer;

                        if ( $level_in_tokenizer < 0 ) {
                            if ( !$self->[_saw_negative_indentation_] ) {
                                $self->[_saw_negative_indentation_] = 1;
                                $self->warning(
                                    "Starting negative indentation\n");
                            }
                        }

                        # restore previous level values
                        if ( length($nesting_block_string) > 1 )
                        {    # true for valid script
                            chop $nesting_block_string;
                            $nesting_block_flag =
                              substr( $nesting_block_string, -1 ) eq '1';
                        }

                    }
                }

                #-----------------------------------------------------
                # Section 2.3. Unexpected sequenced token type - error
                #-----------------------------------------------------
                else {

                    # The tokenizer should only be assigning sequence numbers
                    # to types { [ ( ? ) ] } :
                    DEVEL_MODE && Fault(<<EOM);
unexpected sequence number on token type $type_i with pre-tok=$tok_i
EOM
                }

                #------------------------------------------------
                # Section 2.4. Store values for a sequenced token
                #------------------------------------------------

                # The starting nesting block string, which is used in any .LOG
                # output, should include the first token of the line
                if ( !@output_levels ) {
                    $nesting_block_string_0 = $nesting_block_string;
                }

                # Store values for a sequenced token
                push( @output_levels,        $level_i );
                push( @output_block_type,    $routput_block_type->[$ii] );
                push( @output_type_sequence, $routput_type_sequence->[$ii] );
                push( @output_token_type,    $type_i );

            }
        }    ## End loop to over tokens

        #---------------------
        # Post-loop operations
        #---------------------

        $line_of_tokens->{_nesting_blocks_0} = $nesting_block_string_0;

        # Form and store the tokens
        if (@output_levels) {

            my $im     = shift @{$routput_token_list};
            my $offset = $rtoken_map->[$im];
            foreach my $ii ( @{$routput_token_list} ) {
                my $numc = $rtoken_map->[$ii] - $offset;
                push( @output_tokens, substr( $input_line, $offset, $numc ) );
                $offset += $numc;

                # programming note: it seems most efficient to 'next' out of
                # a critical loop like this as early as possible. So instead
                # of 'if ( DEVEL_MODE && $numc < 0 )' we write:
                next unless (DEVEL_MODE);
                next if ( $numc > 0 );

                # Should not happen unless @{$rtoken_map} is corrupted
                Fault("number of characters is '$numc' but should be >0\n");
            }

            # Form and store the final token of this line
            my $numc = length($input_line) - $offset;
            push( @output_tokens, substr( $input_line, $offset, $numc ) );

            if (DEVEL_MODE) {
                if ( $numc <= 0 ) {

                    # check '$rtoken_map' and '$routput_token_list'
                    Fault("Number of Characters is '$numc' but should be >0\n");
                }

                # Make sure we didn't gain or lose any characters
                my $test_line = join EMPTY_STRING, @output_tokens;
                if ( $test_line ne $input_line ) {
                    my $len_input = length($input_line);
                    my $len_test  = length($test_line);

                    # check '$rtoken_map' and '$routput_token_list'
                    Fault(<<EOM);
Reconstructed line difers from input; input_length=$len_input test_length=$len_test
input:'$input_line'
test :'$test_line'
EOM
                }
            }
        }

        # Wrap up this line of tokens for shipping to the Formatter
        $line_of_tokens->{_rtoken_type}    = \@output_token_type;
        $line_of_tokens->{_rtokens}        = \@output_tokens;
        $line_of_tokens->{_rblock_type}    = \@output_block_type;
        $line_of_tokens->{_rtype_sequence} = \@output_type_sequence;
        $line_of_tokens->{_rlevels}        = \@output_levels;

        #-----------------------------------------------------------------
        # Compare input indentation with computed levels at closing braces
        #-----------------------------------------------------------------
        # This may provide a useful hint for error location if the file
        # is not balanced in braces.  Closing braces are used because they
        # have a well-defined indentation and can be processed efficiently.
        if ( $output_tokens[0] eq '}' ) {

            my $blk = $output_block_type[0];
            if (
                (
                    # builtin block types without continuation indentation
                    $is_zero_continuation_block_type{$blk}

                    # or a named sub, but skip sub aliases for efficiency,
                    # since this is just for diagnostic info
                    || substr( $blk, 0, 4 ) eq 'sub '
                )

                # and we are not in format skipping
                && !$self->[_in_format_skipping_]
              )
            {

                # subtract 1 space for newline in untrimmed line
                my $untrimmed_input_line = $line_of_tokens->{_line_text};
                my $space_count =
                  length($untrimmed_input_line) - length($input_line) - 1;

                # check for tabs
                if ( $space_count
                    && ord( substr( $untrimmed_input_line, 0, 1 ) ) == ORD_TAB )
                {
                    if ( $untrimmed_input_line =~ /^(\t+)?(\s+)?/ ) {
                        if ($1) { $space_count += length($1) * $tabsize }
                        if ($2) { $space_count += length($2) }
                    }
                }

                # '$guess' = the level according to indentation
                my $guess = int( $space_count / $rOpts_indent_columns );

                # subtract 1 level from guess for --indent-closing-brace
                $guess -= 1 if ($rOpts_indent_closing_brace);

                # subtract 1 from $level for each non-indenting brace level
                my $adjust = @{ $self->[_rnon_indenting_brace_stack_] };

                my $level = $output_levels[0];

                # find the difference between expected and indentation guess
                my $level_diff = $level - $adjust - $guess;

                my $rhash = $self->[_rclosing_brace_indentation_hash_];

                # results are only valid if we guess correctly at the
                # first spaced brace
                if ( $space_count && !defined( $rhash->{valid} ) ) {
                    $rhash->{valid} = !$level_diff;
                }

                # save the result
                my $rhistory_line_number  = $rhash->{rhistory_line_number};
                my $rhistory_level_diff   = $rhash->{rhistory_level_diff};
                my $rhistory_anchor_point = $rhash->{rhistory_anchor_point};

                if ( $rhistory_level_diff->[-1] != $level_diff ) {

                    # Patch for non-indenting-braces: if we guess zero and
                    # match before all non-indenting braces have been found,
                    # it means that we would need negative indentation to
                    # match if/when the brace is found. So we have a problem
                    # from here on. We indicate this with a value 2 instead
                    # of 1 as a signal to stop outputting the table here.
                    my $anchor = 1;
                    if ( $guess == 0 && $adjust > 0 ) { $anchor = 2 }

                    # add an anchor point
                    push @{$rhistory_level_diff},   $level_diff;
                    push @{$rhistory_line_number},  $input_line_number;
                    push @{$rhistory_anchor_point}, $anchor;
                }
                else {

                    # add a movable point following an anchor point
                    if ( $rhistory_anchor_point->[-1] ) {
                        push @{$rhistory_level_diff},   $level_diff;
                        push @{$rhistory_line_number},  $input_line_number;
                        push @{$rhistory_anchor_point}, 0;
                    }

                    # extend a movable point
                    else {
                        $rhistory_line_number->[-1] = $input_line_number;
                    }
                }
            }
        }

        return;
    } ## end sub tokenizer_wrapup_line

} ## end tokenize_this_line

#######################################################################
# Tokenizer routines which assist in identifying token types
#######################################################################

# Define Global '%op_expected_table'
#  = hash table of operator expected values based on last nonblank token

# exceptions to perl's weird parsing rules after type 'Z'
my %is_weird_parsing_rule_exception;

my %is_paren_dollar;

my %is_n_v;

BEGIN {

    # Always expecting TERM following these types:
    # note: this is identical to '@value_requestor_type' defined later.
    # Fix for c250: add new type 'P' for package (expecting VERSION or {}
    # after package NAMESPACE, so expecting TERM)
    # Fix for c250: add new type 'S' for sub (not expecting operator)
    my @q = qw#
      ; ! + x & ?  F J - p / Y : % f U ~ A G j L P S * . | ^ < = [ m { > t
      || >= != mm *= => .. !~ == && |= .= pp -= =~ += <= %= ^= x= ~~ ** << /=
      &= // >> ~. &. |. ^.
      ... **= <<= >>= &&= ||= //= <=> !~~ &.= |.= ^.= <<~
      #;
    push @q, BACKSLASH;
    push @q, COMMA;
    push @q, '(';         # for completeness, not currently a token type
    push @q, '->';        # was previously in UNKNOWN
    $op_expected_table{$_} = TERM for @q;

    # No UNKNOWN table types:
    #  removed '->' for c030, now always TERM
    #  removed 'w' for c392 to allow use of 'function_count' info in the sub

    # Always expecting OPERATOR ...
    # 'n' and 'v' are currently excluded because they might be VERSION numbers
    # 'i' is currently excluded because it might be a package
    # 'q' is currently excluded because it might be a prototype
    # Fix for c030: removed '->' from this list:
    # Fix for c250: added 'i' because new type 'P' was added
    @q = qw( -- C h R ++ ] Q <> i );
    push @q, ')';
    $op_expected_table{$_} = OPERATOR for @q;

    # Fix for git #62: added '*' and '%'
    @q = qw( < ? * % );
    $is_weird_parsing_rule_exception{$_} = 1 for @q;

    @q = qw<) $>;
    $is_paren_dollar{$_} = 1 for @q;

    @q = qw( n v );
    $is_n_v{$_} = 1 for @q;

} ## end BEGIN

use constant DEBUG_OPERATOR_EXPECTED => 0;

sub operator_expected {

    my ( $self, $tok, $next_type, $blank_after_Z ) = @_;

    # Returns a parameter indicating what types of tokens can occur next

    # Call format:
    #    $op_expected =
    #      $self->operator_expected( $tok, $next_type, $blank_after_Z );
    # where
    #    $tok is the current token
    #    $next_type is the type of the next token (blank or not)
    #    $blank_after_Z = flag for guessing after a type 'Z':
    #       true  if $tok follows type 'Z' with intermediate blank
    #       false if $tok follows type 'Z' with no intermediate blank
    #       ignored if $tok does not follow type 'Z'

    # Many perl symbols have two or more meanings.  For example, '<<'
    # can be a shift operator or a here-doc operator.  The
    # interpretation of these symbols depends on the current state of
    # the tokenizer, which may either be expecting a term or an
    # operator.  For this example, a << would be a shift if an OPERATOR
    # is expected, and a here-doc if a TERM is expected.  This routine
    # is called to make this decision for any current token.  It returns
    # one of three possible values:
    #
    #     OPERATOR - operator expected (or at least, not a term)
    #     UNKNOWN  - can't tell
    #     TERM     - a term is expected (or at least, not an operator)
    #
    # The decision is based on what has been seen so far.  This
    # information is stored in the "$last_nonblank_type" and
    # "$last_nonblank_token" variables.  For example, if the
    # $last_nonblank_type is '=~', then we are expecting a TERM, whereas
    # if $last_nonblank_type is 'n' (numeric), we are expecting an
    # OPERATOR.
    #
    # If a UNKNOWN is returned, the calling routine must guess. A major
    # goal of this tokenizer is to minimize the possibility of returning
    # UNKNOWN, because a wrong guess can spoil the formatting of a
    # script.
    #
    # Adding NEW_TOKENS: it is critically important that this routine be
    # updated to allow it to determine if an operator or term is to be
    # expected after the new token.  Doing this simply involves adding
    # the new token character to one of the regexes in this routine or
    # to one of the hash lists
    # that it uses, which are initialized in the BEGIN section.
    # USES GLOBAL VARIABLES: $last_nonblank_type, $last_nonblank_token,
    # $statement_type

    # When possible, token types should be selected such that we can determine
    # the 'operator_expected' value by a simple hash lookup.  If there are
    # exceptions, that is an indication that a new type is needed.

    #--------------------------------------------
    # Section 1: Table lookup will get most cases
    #--------------------------------------------

    # Many types are can be obtained by a table lookup.  This typically handles
    # more than half of the calls.  For speed, the caller may try table lookup
    # first before calling this sub.
    my $op_expected = $op_expected_table{$last_nonblank_type};
    if ( defined($op_expected) ) {
        DEBUG_OPERATOR_EXPECTED
          && print {*STDOUT}
"OPERATOR_EXPECTED: Table Lookup; returns $op_expected for last type $last_nonblank_type token $last_nonblank_token\n";
        return $op_expected;
    }

    DEBUG_OPERATOR_EXPECTED
      && print {*STDOUT}
"OPERATOR_EXPECTED: in hardwired table for last type $last_nonblank_type token $last_nonblank_token\n";

    #---------------------------------------------
    # Section 2: Handle special cases if necessary
    #---------------------------------------------

    # Types 'k', '}' and 'Z' depend on context
    # Types 'n', 'v', 'q' also depend on context.

    # identifier...
    # Fix for c250: removed coding for type 'i' because 'i' and new type 'P'
    # are now done by hash table lookup

    #--------------------
    # Section 2A: keyword
    #--------------------
    if ( $last_nonblank_type eq 'k' ) {

        # keywords expecting TERM:
        if ( $expecting_term_token{$last_nonblank_token} ) {

            # Exceptions from TERM:

            # // may follow perl functions which may be unary operators
            # see test file dor.t (defined or);
            if (
                   $tok eq '/'
                && $next_type eq '/'
                && $is_keyword_rejecting_slash_as_pattern_delimiter{
                    $last_nonblank_token}
              )
            {
                return OPERATOR;
            }

            # Patch to allow a ? following 'split' to be a deprecated pattern
            # delimiter.  This patch is coordinated with the omission of split
            # from the list
            # %is_keyword_rejecting_question_as_pattern_delimiter. This patch
            # will force perltidy to guess.
            if (   $tok eq '?'
                && $last_nonblank_token eq 'split' )
            {
                return UNKNOWN;
            }

            return TERM;
        }

        # keywords expecting OPERATOR:
        if ( $expecting_operator_token{$last_nonblank_token} ) {
            return OPERATOR;
        }

        return TERM;

    } ## end type 'k'

    #------------------------------------
    # Section 2B: Closing container token
    #------------------------------------

    # Note that the actual token for type '}' may also be a ')'.

    # Also note that $last_nonblank_token is not the token corresponding to
    # $last_nonblank_type when the type is a closing container.  In that
    # case it is the token before the corresponding opening container token.
    # So for example, for this snippet
    #       $a = do { BLOCK } / 2;
    # the $last_nonblank_token is 'do' when $last_nonblank_type eq '}'.

    if ( $last_nonblank_type eq '}' ) {

        #-------------------------------------------
        # Section 2B1: Closing structural ')' or ']'
        #-------------------------------------------
        if ( $last_nonblank_token eq ')' || $last_nonblank_token eq ']' ) {
            return OPERATOR;
        }

        #-------------------------------------
        # Section 2B2: Closing block brace '}'
        #-------------------------------------
        my $blk = $rbrace_type->[ $brace_depth + 1 ];

        # Non-blocks
        if ( !defined($blk) ) {
            return OPERATOR;
        }

        # Unidentified block type
        if ( !$blk ) {
            return UNKNOWN;
        }

        # Blocks followed by a TERM
        if (   $is_zero_continuation_block_type{$blk}
            || $is_sort_map_grep{$blk}
            || $is_grep_alias{$blk}
            || substr( $blk, -1, 1 ) eq ':'       && $blk =~ /^\w+:$/
            || substr( $blk,  0, 3 ) eq 'sub'     && $blk =~ /^sub\s/
            || substr( $blk,  0, 7 ) eq 'package' && $blk =~ /^package\s/ )
        {
            return TERM;
        }

        # Blocks followed by an OPERATOR
        #    do eval sub
        if (   $is_block_operator{$blk}
            || $is_sub{$blk} )
        {
            return OPERATOR;
        }

        # Any other block type is marked UNKNOWN to be safe (c566).
        # For example, a block type marked ';' could be a hash ref:
        #    { map { $_ => 'x' } keys %main:: } ~~ \%main::;
        # The tokenizer would have to analyze the contents to distinguish
        # between a block closure and a hash ref brace in this case.  So mark
        # this as UNKNOWN and let the lower level routines figure it out.
        return UNKNOWN;
    }

    #-------------------------------
    # Section 2C: number or v-string
    #-------------------------------
    # An exception is for VERSION numbers a 'use' statement. It has the format
    #     use Module VERSION LIST
    # We could avoid this exception by writing a special sub to parse 'use'
    # statements and perhaps mark these numbers with a new type V (for VERSION)
    if ( $is_n_v{$last_nonblank_type} ) {
        if ( $statement_type eq 'use' ) {
            return UNKNOWN;
        }
        return OPERATOR;
    }

    #---------------------
    # Section 2D: qw quote
    #---------------------
    # TODO: labeled prototype words would better be given type 'A' or maybe
    # 'J'; not 'q'; or maybe mark as type 'Y'?
    if ( $last_nonblank_type eq 'q' ) {
        if ( $last_nonblank_token eq 'prototype' ) {
            return TERM;
        }

        # update for --use-feature=class (rt145706):
        # Look for class VERSION after possible attribute, as in
        #    class Example::Subclass : isa(Example::Base) 1.345 { ... }
        if ( $statement_type =~ /^package\b/ ) {
            return TERM;
        }

        # everything else
        return OPERATOR;
    }

    #---------------------
    # Section 2E: bareword
    #---------------------
    if ( $last_nonblank_type eq 'w' ) {

        # It is safest to return UNKNOWN if a possible ? pattern delimiter may
        # follow (git #32, c469) and let the guess algorithm handle it.
        if ( $tok eq '?' ) { return UNKNOWN }

        # see if this has been seen in the role of a function taking args
        my $rinfo = $self->[_rbareword_info_]->{$current_package};
        if ($rinfo) {
            $rinfo = $rinfo->{$last_nonblank_token};
            if ($rinfo) {
                my $function_count = $rinfo->{function_count};
                if ( $function_count && $function_count > 0 ) { return TERM }
            }
        }
        return UNKNOWN;
    }

    #-----------------------------------
    # Section 2F: file handle or similar
    #-----------------------------------
    if ( $last_nonblank_type eq 'Z' ) {

        # angle.t
        if ( $last_nonblank_token =~ /^\w/ ) {
            return UNKNOWN;
        }

        # Exception to weird parsing rules for 'x(' ... see case b1205:
        # In something like 'print $vv x(...' the x is an operator;
        # Likewise in 'print $vv x$ww' the x is an operator (case b1207)
        # otherwise x follows the weird parsing rules.
        if ( $tok eq 'x' && $next_type =~ /^[\(\$\@\%]$/ ) {
            return OPERATOR;
        }

        # The 'weird parsing rules' of next section do not work for '<' and '?'
        # It is best to mark them as unknown.  Test case:
        #  print $fh <DATA>;
        if ( $is_weird_parsing_rule_exception{$tok} ) {
            return UNKNOWN;
        }

        # For possible file handle like "$a", Perl uses weird parsing rules.
        # For example:
        # print $a/2,"/hi";   - division
        # print $a / 2,"/hi"; - division
        # print $a/ 2,"/hi";  - division
        # print $a /2,"/hi";  - pattern (and error)!
        # Some examples where this logic works okay, for '&','*','+':
        #    print $fh &xsi_protos(@mods);
        #    my $x = new $CompressClass *FH;
        #    print $OUT +( $count % 15 ? ", " : "\n\t" );
        if (   $blank_after_Z
            && $next_type ne 'b' )
        {
            return TERM;
        }

        # Note that '?' and '<' have been moved above
        # ( $tok =~ /^([x\/\+\-\*\%\&\.\?\<]|\>\>)$/ ) {
        if ( $tok =~ /^([x\/\+\-\*\%\&\.]|\>\>)$/ ) {

            # Do not complain in 'use' statements, which have special syntax.
            # For example, from RT#130344:
            #   use lib $FindBin::Bin . '/lib';
            if ( $statement_type ne 'use' ) {
                $self->complain(
"operator in possible indirect object location not recommended\n"
                );
            }
            return OPERATOR;
        }

        # all other cases

        return UNKNOWN;
    }

    #--------------------------
    # Section 2F: anything else
    #--------------------------
    return UNKNOWN;

} ## end sub operator_expected

sub new_statement_ok {

    # Returns:
    #   true if a new statement can begin here
    #   false otherwise

    # USES GLOBAL VARIABLES: $last_nonblank_token, $last_nonblank_type,
    # $brace_depth, $rbrace_type

    # Uses:
    # - See if a 'class' statement can occur here
    # - See if a keyword begins at a new statement; i.e. is an 'if' a
    #   block if or a trailing if?  Also see if 'format' starts a statement.
    # - Decide if a ':' is part of a statement label (not a ternary)

    # Curly braces are tricky because some small blocks do not get marked as
    # blocks..

    # if it follows an opening curly brace..
    if ( $last_nonblank_token eq '{' ) {

        # The safe thing is to return true in all cases because:
        # - a ternary ':' cannot occur here
        # - an 'if' here, for example, cannot be a trailing if
        # See test case c231 for an example.
        # This works but could be improved, if necessary, by returning
        #   'false' at obvious non-blocks.
        return 1;
    }

    # if it follows a closing code block curly brace..
    elsif ($last_nonblank_token eq '}'
        && $last_nonblank_type eq $last_nonblank_token )
    {

        # A new statement can follow certain closing block braces ...
        # Previously, a true was always returned, and this worked ok.
        # Update c443: now we return false for certain blocks which must be
        # followed by a ';'.  See comments elsewhere on
        # '%is_zero_continuation_block_type'. The value of $brace_depth has
        # also been corrected, it was off by 1.
        my $block_type = $rbrace_type->[ $brace_depth + 1 ];
        return $block_type
          && !$is_sort_map_grep_eval_do_sub{$block_type};
    }

    # otherwise, it is a label if and only if it follows a ';' (real or fake)
    # or another label
    else {
        return ( $last_nonblank_type eq ';' || $last_nonblank_type eq 'J' );
    }
} ## end sub new_statement_ok

sub code_block_type {

    my ( $self, $i, $rtokens, $rtoken_type, $max_token_index ) = @_;

    # Decide if this is a block of code, and its type.
    # Must be called only when $type = $token = '{'
    # The problem is to distinguish between the start of a block of code
    # and the start of an anonymous hash reference
    # Returns "" if not code block, otherwise returns 'last_nonblank_token'
    # to indicate the type of code block.  (For example, 'last_nonblank_token'
    # might be 'if' for an if block, 'else' for an else block, etc).
    # USES GLOBAL VARIABLES: $last_nonblank_token, $last_nonblank_type,
    # $last_nonblank_block_type, $brace_depth, $rbrace_type

    # handle case of multiple '{'s

#print "BLOCK_TYPE EXAMINING: type=$last_nonblank_type tok=$last_nonblank_token\n";

    if (   $last_nonblank_token eq '{'
        && $last_nonblank_type eq $last_nonblank_token )
    {

        # opening brace where a statement may appear is probably
        # a code block but might be and anonymous hash reference
        if ( $rbrace_type->[$brace_depth] ) {
            return $self->decide_if_code_block( $i, $rtokens, $rtoken_type,
                $max_token_index );
        }

        # cannot start a code block within an anonymous hash
        else {
            return EMPTY_STRING;
        }
    }

    elsif ( $last_nonblank_token eq ';' ) {

        # an opening brace where a statement may appear is probably
        # a code block but might be and anonymous hash reference
        return $self->decide_if_code_block( $i, $rtokens, $rtoken_type,
            $max_token_index );
    }

    # handle case of '}{'
    elsif ($last_nonblank_token eq '}'
        && $last_nonblank_type eq $last_nonblank_token )
    {

        # a } { situation ...
        # could be hash reference after code block..(blktype1.t)
        if ($last_nonblank_block_type) {
            return $self->decide_if_code_block( $i, $rtokens, $rtoken_type,
                $max_token_index );
        }

        # must be a block if it follows a closing hash reference
        else {
            return $last_nonblank_token;
        }
    }

    #--------------------------------------------------------------
    # NOTE: braces after type characters start code blocks, but for
    # simplicity these are not identified as such.  See also
    # sub is_non_structural_brace.
    #--------------------------------------------------------------

##    elsif ( $last_nonblank_type eq 't' ) {
##       return $last_nonblank_token;
##    }

    # brace after label:
    elsif ( $last_nonblank_type eq 'J' ) {
        return $last_nonblank_token;
    }

    # otherwise, see if a block must follow the previous token (such as 'if'):
    elsif ($is_code_block_token{$last_nonblank_token}
        || $is_grep_alias{$last_nonblank_token} )
    {

        # Bug Patch: Note that the opening brace after the 'if' in the following
        # snippet is an anonymous hash ref and not a code block!
        #   print 'hi' if { x => 1, }->{x};
        # We can identify this situation because the last nonblank type
        # will be a keyword (instead of a closing paren)
        if (
            $last_nonblank_type eq 'k'
            && (   $last_nonblank_token eq 'if'
                || $last_nonblank_token eq 'unless' )
          )
        {
            return EMPTY_STRING;
        }
        else {
            return $last_nonblank_token;
        }
    }

    # or a sub or package BLOCK
    # Fixed for c250 to include new package type 'P', and change 'i' to 'S'
    elsif (
           $last_nonblank_type eq 'P'
        || $last_nonblank_type eq 'S'
        || ( $last_nonblank_type eq 't'
            && substr( $last_nonblank_token, 0, 3 ) eq 'sub' )
      )
    {
        return $last_nonblank_token;
    }

    elsif ( $statement_type =~ /^(sub|package)\b/ ) {
        return $statement_type;
    }

    # user-defined subs with block parameters (like grep/map/eval)
    elsif ( $last_nonblank_type eq 'G' ) {
        return $last_nonblank_token;
    }

    # check bareword
    elsif ( $last_nonblank_type eq 'w' ) {

        # check for syntax 'use MODULE LIST'
        # This fixes b1022 b1025 b1027 b1028 b1029 b1030 b1031
        return EMPTY_STRING if ( $statement_type eq 'use' );

        return $self->decide_if_code_block( $i, $rtokens, $rtoken_type,
            $max_token_index );
    }

    # Patch for bug # RT #94338 reported by Daniel Trizen
    # for-loop in a parenthesized block-map triggering an error message:
    #    map( { foreach my $item ( '0', '1' ) { print $item} } qw(a b c) );
    # Check for a code block within a parenthesized function call
    elsif ( $last_nonblank_token eq '(' ) {
        my $paren_type = $rparen_type->[$paren_depth];

        #                   /^(map|grep|sort)$/
        if ( $paren_type && $is_sort_map_grep{$paren_type} ) {

            # We will mark this as a code block but use type 't' instead
            # of the name of the containing function.  This will allow for
            # correct parsing but will usually produce better formatting.
            # Braces with block type 't' are not broken open automatically
            # in the formatter as are other code block types, and this usually
            # works best.
            return 't';    # (Not $paren_type)
        }
        else {
            return EMPTY_STRING;
        }
    }

    # handle unknown syntax ') {'
    # we previously appended a '()' to mark this case
    elsif ( $last_nonblank_token =~ /\(\)$/ ) {
        return $last_nonblank_token;
    }

    # anything else must be anonymous hash reference
    else {
        return EMPTY_STRING;
    }
} ## end sub code_block_type

sub decide_if_code_block {

    # USES GLOBAL VARIABLES: $last_nonblank_token
    my ( $self, $i, $rtokens, $rtoken_type, $max_token_index ) = @_;

    my ( $next_nonblank_token, $i_next_uu ) =
      $self->find_next_nonblank_token( $i, $rtokens, $max_token_index );

    # we are at a '{' where a statement may appear.
    # We must decide if this brace starts an anonymous hash or a code
    # block.
    # return "" if anonymous hash, and $last_nonblank_token otherwise

    # initialize to be code BLOCK
    my $code_block_type = $last_nonblank_token;

    # Check for the common case of an empty anonymous hash reference:
    # Maybe something like sub { { } }
    if ( $next_nonblank_token eq '}' ) {
        $code_block_type = EMPTY_STRING;
    }

    else {

        # To guess if this '{' is an anonymous hash reference, look ahead
        # and test as follows:
        #
        # it is a hash reference if next come:
        #   - a string or digit followed by a comma or =>
        #   - bareword followed by =>
        # otherwise it is a code block
        #
        # Examples of anonymous hash ref:
        # {'aa',};
        # {1,2}
        #
        # Examples of code blocks:
        # {1; print "hello\n", 1;}
        # {$a,1};

        # We are only going to look ahead one more (nonblank/comment) line.
        # Strange formatting could cause a bad guess, but that's unlikely.
        my @pre_types;
        my @pre_tokens;

        # Ignore the rest of this line if it is a side comment
        if ( $next_nonblank_token ne '#' ) {
            @pre_types  = @{$rtoken_type}[ $i + 1 .. $max_token_index ];
            @pre_tokens = @{$rtokens}[ $i + 1 .. $max_token_index ];
        }

        # Here 20 is arbitrary but generous, and prevents wasting lots of time
        # in mangled files
        my ( $rpre_tokens, $rpre_types ) =
          $self->peek_ahead_for_n_nonblank_pre_tokens(20);
        if ( defined($rpre_types) && @{$rpre_types} ) {
            push @pre_types,  @{$rpre_types};
            push @pre_tokens, @{$rpre_tokens};
        }

        # put a sentinel token to simplify stopping the search
        push @pre_types, '}';
        push @pre_types, '}';

        my $jbeg = 0;
        $jbeg = 1 if ( $pre_types[0] eq 'b' );

        # first look for one of these
        #  - bareword
        #  - bareword with leading -
        #  - digit
        #  - quoted string
        my $j = $jbeg;
        if ( $pre_types[$j] =~ /^[\'\"]/ ) {

            # find the closing quote; don't worry about escapes
            my $quote_mark = $pre_types[$j];
            foreach my $k ( $j + 1 .. @pre_types - 2 ) {
                if ( $pre_types[$k] eq $quote_mark ) {
                    $j = $k + 1;
                    last;
                }
            }
        }
        elsif ( $pre_types[$j] eq 'd' ) {
            $j++;
        }
        elsif ( $pre_types[$j] eq 'w' ) {
            $j++;
        }
        elsif ( $pre_types[$j] eq '-' && $pre_types[ ++$j ] eq 'w' ) {
            $j++;
        }
        else {
            ## none of the above
        }
        if ( $j > $jbeg ) {

            $j++ if ( $pre_types[$j] eq 'b' );

            # Patched for RT #95708
            if (

                # it is a comma which is not a pattern delimiter except for qw
                (
                    $pre_types[$j] eq COMMA
                    && !$is_q_qq_qx_qr_s_y_tr_m{ $pre_tokens[$jbeg] }
                )

                # or a =>
                || ( $pre_types[$j] eq '=' && $pre_types[ ++$j ] eq '>' )
              )
            {
                $code_block_type = EMPTY_STRING;
            }
        }

        if ($code_block_type) {

            # Patch for cases b1085 b1128: It is uncertain if this is a block.
            # If this brace follows a bareword, then append a space as a signal
            # to the formatter that this may not be a block brace.  To find the
            # corresponding code in Formatter.pm search for 'b1085'.
            # But not for the word 'method': fixes c534; this will cause the
            # formatter to mark an asub block instead of a sub block.
            if ( $code_block_type =~ /^\w/ && $code_block_type ne 'method' ) {
                $code_block_type .= SPACE;
            }
        }
    }

    return $code_block_type;
} ## end sub decide_if_code_block

sub report_unexpected {

    # report unexpected token type and show where it is
    # USES GLOBAL VARIABLES: (none)
    my ( $self, $rcall_hash ) = @_;

    my $found           = $rcall_hash->{found};
    my $expecting       = $rcall_hash->{expecting};
    my $i_tok           = $rcall_hash->{i_tok};
    my $last_nonblank_i = $rcall_hash->{last_nonblank_i};
    my $rpretoken_map   = $rcall_hash->{rpretoken_map};
    my $rpretoken_type  = $rcall_hash->{rpretoken_type};
    my $input_line      = $rcall_hash->{input_line};

    if ( ++$self->[_unexpected_error_count_] <= MAX_NAG_MESSAGES ) {
        my $msg = "found $found where $expecting expected";
        my $pos = $rpretoken_map->[$i_tok];
        $self->interrupt_logfile();
        my $input_line_number = $self->[_last_line_number_];
        my ( $offset, $numbered_line, $underline ) =
          make_numbered_line( $input_line_number, $input_line, $pos );
        $underline = write_on_underline( $underline, $pos - $offset, '^' );

        my $trailer = EMPTY_STRING;
        if ( ( $i_tok > 0 ) && ( $last_nonblank_i >= 0 ) ) {
            my $pos_prev = $rpretoken_map->[$last_nonblank_i];
            my $num;
            if ( $rpretoken_type->[ $i_tok - 1 ] eq 'b' ) {
                $num = $rpretoken_map->[ $i_tok - 1 ] - $pos_prev;
            }
            else {
                $num = $pos - $pos_prev;
            }
            if ( $num > 40 ) { $num = 40; $pos_prev = $pos - 40; }

            $underline =
              write_on_underline( $underline, $pos_prev - $offset, '-' x $num );
            $trailer = " (previous token underlined)";
        }
        $underline =~ s/\s+$//;
        $self->warning( $numbered_line . "\n" );
        $self->warning( $underline . "\n" );
        $self->warning( $msg . $trailer . "\n" );
        $self->resume_logfile();
    }
    return;
} ## end sub report_unexpected

my %is_sigil_or_paren;
my %is_R_closing_sb;

BEGIN {

    my @q = qw< $ & % * @ ) >;
    $is_sigil_or_paren{$_} = 1 for @q;

    @q = qw( R ] );
    $is_R_closing_sb{$_} = 1 for @q;
} ## end BEGIN

sub is_non_structural_brace {

    # Decide if a brace or bracket is structural or non-structural
    # by looking at the previous token and type
    # USES GLOBAL VARIABLES: $last_nonblank_type, $last_nonblank_token

    # EXPERIMENTAL: Mark slices as structural; idea was to improve formatting.
    # Tentatively deactivated because it caused the wrong operator expectation
    # for this code:
    #      $user = @vars[1] / 100;
    # Must update sub operator_expected before re-implementing.
    # if ( $last_nonblank_type eq 'i' && $last_nonblank_token =~ /^@/ ) {
    #    return 0;
    # }

    #--------------------------------------------------------------
    # NOTE: braces after type characters start code blocks, but for
    # simplicity these are not identified as such.  See also
    # sub code_block_type
    #--------------------------------------------------------------

    ##if ($last_nonblank_type eq 't') {return 0}

    # otherwise, it is non-structural if it is decorated
    # by type information.
    # For example, the '{' here is non-structural:   ${xxx}
    # Removed '::' to fix c074
    ## $last_nonblank_token =~ /^([\$\@\*\&\%\)]|->|::)/
    return (
        ## $last_nonblank_token =~ /^([\$\@\*\&\%\)]|->)/
        $is_sigil_or_paren{ substr( $last_nonblank_token, 0, 1 ) }
          || substr( $last_nonblank_token, 0, 2 ) eq '->'

          # or if we follow a hash or array closing curly brace or bracket
          # For example, the second '{' in this is non-structural: $a{'x'}{'y'}
          # because the first '}' would have been given type 'R'
          ##|| $last_nonblank_type =~ /^([R\]])$/
          || $is_R_closing_sb{$last_nonblank_type}
    );
} ## end sub is_non_structural_brace

#######################################################################
# Tokenizer routines for tracking container nesting depths
#######################################################################

# The following routines keep track of nesting depths of the nesting
# types, ( [ { and ?.  This is necessary for determining the indentation
# level, and also for debugging programs.  Not only do they keep track of
# nesting depths of the individual brace types, but they check that each
# of the other brace types is balanced within matching pairs.  For
# example, if the program sees this sequence:
#
#         {  ( ( ) }
#
# then it can determine that there is an extra left paren somewhere
# between the { and the }.  And so on with every other possible
# combination of outer and inner brace types.  For another
# example:
#
#         ( [ ..... ]  ] )
#
# which has an extra ] within the parens.
#
# The brace types have indexes 0 .. 3 which are indexes into
# the matrices.
#
# The pair ? : are treated as just another nesting type, with ? acting
# as the opening brace and : acting as the closing brace.
#
# The matrix
#
#  $rdepth_array->[$a][$b][ $rcurrent_depth->[$a] ] = $rcurrent_depth->[$b];
#
# saves the nesting depth of brace type $b (where $b is either of the other
# nesting types) when brace type $a enters a new depth.  When this depth
# decreases, a check is made that the current depth of brace types $b is
# unchanged, or otherwise there must have been an error.  This can
# be very useful for localizing errors, particularly when perl runs to
# the end of a large file (such as this one) and announces that there
# is a problem somewhere.
#
# A numerical sequence number is maintained for every nesting type,
# so that each matching pair can be uniquely identified in a simple
# way.

sub increase_nesting_depth {
    my ( $self, $aa, $pos ) = @_;

    # Given:
    #   $aa = integer code of container type, 0-3
    #   $pos = position of character, for error message

    # USES GLOBAL VARIABLES: $rcurrent_depth,
    # $rcurrent_sequence_number, $rdepth_array,
    # $rstarting_line_of_current_depth, $statement_type
    my $cd_aa = ++$rcurrent_depth->[$aa];
    $total_depth++;
    $rtotal_depth->[$aa]->[$cd_aa] = $total_depth;
    my $input_line_number = $self->[_last_line_number_];
    my $input_line        = $self->[_line_of_text_];

    # Sequence numbers increment by number of items.  This keeps
    # a unique set of numbers but still allows the relative location
    # of any type to be determined.

    # make a new unique sequence number
    my $seqno = $next_sequence_number++;

    # Remember the type sequence number at the current depth,
    # but do not overwrite the root sequence number.
    if ( $total_depth > 0 ) {
        $self->[_rseqno_at_depth_]->[$total_depth] = $seqno;
    }

    $rcurrent_sequence_number->[$aa]->[$cd_aa] = $seqno;

    $rstarting_line_of_current_depth->[$aa]->[$cd_aa] =
      [ $input_line_number, $input_line, $pos ];

    for my $bb ( 0 .. @closing_brace_names - 1 ) {
        next if ( $bb == $aa );
        $rdepth_array->[$aa]->[$bb]->[$cd_aa] = $rcurrent_depth->[$bb];
    }

    # set a flag for indenting a nested ternary statement
    my $indent = 0;
    if ( $aa == QUESTION_COLON ) {
        $rnested_ternary_flag->[$cd_aa] = 0;
        if ( $cd_aa > 1 ) {
            if ( $rnested_ternary_flag->[ $cd_aa - 1 ] == 0 ) {
                my $pdepth = $rtotal_depth->[$aa]->[ $cd_aa - 1 ];
                if ( $pdepth == $total_depth - 1 ) {
                    $indent = 1;
                    $rnested_ternary_flag->[ $cd_aa - 1 ] = -1;
                }
            }
        }
    }

    # Fix part #1 for git82: save last token type for propagation of type 'Z'
    $rnested_statement_type->[$aa]->[$cd_aa] =
      [ $statement_type, $last_nonblank_type, $last_nonblank_token ];
    $statement_type = EMPTY_STRING;
    return ( $seqno, $indent );
} ## end sub increase_nesting_depth

sub is_balanced_closing_container {

    my ($aa) = @_;

    # Return true if a closing container can go here without error
    # Return false if not
    # Given:
    #   $aa = integer code of container type, 0-3

    # cannot close if there was no opening
    my $cd_aa = $rcurrent_depth->[$aa];
    return if ( $cd_aa <= 0 );

    # check that any other brace types $bb contained within would be balanced
    for my $bb ( 0 .. @closing_brace_names - 1 ) {
        next if ( $bb == $aa );
        return
          if (
            $rdepth_array->[$aa]->[$bb]->[$cd_aa] != $rcurrent_depth->[$bb] );
    }

    # OK, everything will be balanced
    return 1;
} ## end sub is_balanced_closing_container

sub decrease_nesting_depth {

    my ( $self, $aa, $pos ) = @_;

    # Given:
    #   $aa = integer code of container type, 0-3
    #   $pos = position of character, for error message

    # USES GLOBAL VARIABLES: $rcurrent_depth,
    # $rcurrent_sequence_number, $rdepth_array, $rstarting_line_of_current_depth
    # $statement_type
    my $seqno             = 0;
    my $input_line_number = $self->[_last_line_number_];
    my $input_line        = $self->[_line_of_text_];

    my $outdent = 0;
    $total_depth--;
    my $cd_aa = $rcurrent_depth->[$aa];
    if ( $cd_aa > 0 ) {

        # set a flag for un-indenting after seeing a nested ternary statement
        $seqno = $rcurrent_sequence_number->[$aa]->[$cd_aa];
        if ( $aa == QUESTION_COLON ) {
            $outdent = $rnested_ternary_flag->[$cd_aa];
        }

        # Fix part #2 for git82: use saved type for propagation of type 'Z'
        # through type L-R braces.  Perl seems to allow ${bareword}
        # as an indirect object, but nothing much more complex than that.
        ( $statement_type, my $saved_type, my $saved_token_uu ) =
          @{ $rnested_statement_type->[$aa]->[ $rcurrent_depth->[$aa] ] };
        if (   $aa == BRACE
            && $saved_type eq 'Z'
            && $last_nonblank_type eq 'w'
            && $rbrace_structural_type->[$brace_depth] eq 'L' )
        {
            $last_nonblank_type = $saved_type;
        }

        # check that any brace types $bb contained within are balanced
        for my $bb ( 0 .. @closing_brace_names - 1 ) {
            next if ( $bb == $aa );

            if ( $rdepth_array->[$aa]->[$bb]->[$cd_aa] !=
                $rcurrent_depth->[$bb] )
            {
                my $diff =
                  $rcurrent_depth->[$bb] -
                  $rdepth_array->[$aa]->[$bb]->[$cd_aa];

                # don't whine too many times
                my $saw_brace_error = $self->get_saw_brace_error();
                if (
                    $saw_brace_error <= MAX_NAG_MESSAGES

                    # if too many closing types have occurred, we probably
                    # already caught this error
                    && ( ( $diff > 0 ) || ( $saw_brace_error <= 0 ) )
                  )
                {
                    $self->interrupt_logfile();
                    my $rsl = $rstarting_line_of_current_depth->[$aa]->[$cd_aa];
                    my $sl  = $rsl->[0];
                    my $rel = [ $input_line_number, $input_line, $pos ];
                    my $el  = $rel->[0];
                    my ($ess);

                    if ( $diff == 1 || $diff == -1 ) {
                        $ess = EMPTY_STRING;
                    }
                    else {
                        $ess = 's';
                    }
                    my $bname =
                      ( $diff > 0 )
                      ? $opening_brace_names[$bb]
                      : $closing_brace_names[$bb];
                    $self->write_error_indicator_pair( @{$rsl}, '^' );
                    my $msg = <<"EOM";
Found $diff extra $bname$ess between $opening_brace_names[$aa] on line $sl and $closing_brace_names[$aa] on line $el
EOM

                    if ( $diff > 0 ) {
                        my $rml =
                          $rstarting_line_of_current_depth->[$bb]
                          ->[ $rcurrent_depth->[$bb] ];
                        my $ml = $rml->[0];
                        $msg .=
"    The most recent un-matched $bname is on line $ml\n";
                        $self->write_error_indicator_pair( @{$rml}, '^' );
                    }
                    $self->write_error_indicator_pair( @{$rel}, '^' );
                    $self->warning($msg);
                    $self->resume_logfile();
                }
                $self->increment_brace_error();
                if ( $bb eq BRACE ) { $self->[_show_indentation_table_] = 1 }
            }
        }
        $rcurrent_depth->[$aa]--;
    }
    else {

        my $saw_brace_error = $self->get_saw_brace_error();
        if ( $saw_brace_error <= MAX_NAG_MESSAGES ) {
            my $msg = <<"EOM";
There is no previous $opening_brace_names[$aa] to match a $closing_brace_names[$aa] on line $input_line_number
EOM
            $self->indicate_error( $msg, $input_line_number, $input_line, $pos,
                '^' );
        }
        $self->increment_brace_error();
        if ( $aa eq BRACE ) { $self->[_show_indentation_table_] = 1 }

        # keep track of errors in braces alone (ignoring ternary nesting errors)
        $self->[_true_brace_error_count_]++
          if ( $closing_brace_names[$aa] ne "':'" );
    }
    return ( $seqno, $outdent );
} ## end sub decrease_nesting_depth

sub check_final_nesting_depths {

    # USES GLOBAL VARIABLES: $rcurrent_depth, $rstarting_line_of_current_depth
    my $self = shift;

    for my $aa ( 0 .. @closing_brace_names - 1 ) {

        my $cd_aa = $rcurrent_depth->[$aa];
        if ($cd_aa) {
            my $rsl = $rstarting_line_of_current_depth->[$aa]->[$cd_aa];
            my $sl  = $rsl->[0];

            # Add hint for something like a missing terminal ':' of a ternary
            my $hint = EMPTY_STRING;
            if ( $cd_aa == 1 ) {
                $hint =
                  " .. did not find its closing $closing_brace_names[$aa]";
            }
            my $msg = <<"EOM";
Final nesting depth of $opening_brace_names[$aa]s is $cd_aa
The most recent un-matched $opening_brace_names[$aa] is on line $sl$hint
EOM
            $self->indicate_error( $msg, @{$rsl}, '^' );
            $self->increment_brace_error();
            if ( $aa eq BRACE ) { $self->[_show_indentation_table_] = 1 }
        }
    }
    return;
} ## end sub check_final_nesting_depths

#######################################################################
# Tokenizer routines for looking ahead in input stream
#######################################################################

sub peek_ahead_for_n_nonblank_pre_tokens {

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

    # Given:
    #   $max_pretokens = number of pretokens wanted
    # Return:
    #   next $max_pretokens pretokens if they exist
    #   undef's if hits eof without seeing any pretokens

    # USES GLOBAL VARIABLES: (none)
    my $line;
    my $i = 0;
    my ( $rpre_tokens, $rmap, $rpre_types );

    while ( defined( $line = $self->peek_ahead( $i++ ) ) ) {
        $line =~ s/^\s+//;                 # trim leading blanks
        next if ( length($line) <= 0 );    # skip blank
        next if ( $line =~ /^#/ );         # skip comment
        ( $rpre_tokens, $rmap, $rpre_types ) =
          pre_tokenize( $line, $max_pretokens );
        last;
    } ## end while ( defined( $line = ...))
    return ( $rpre_tokens, $rpre_types );
} ## end sub peek_ahead_for_n_nonblank_pre_tokens

# look ahead for next non-blank, non-comment line of code
sub peek_ahead_for_nonblank_token {

    my ( $self, $rtokens, $max_token_index ) = @_;

    # Given:
    #   $rtokens = ref to token array
    #   $max_token_index = index of last token in $rtokens
    # Task:
    #   Update $rtokens with next nonblank token

    # USES GLOBAL VARIABLES: (none)
    my $line;
    my $i = 0;

    while ( defined( $line = $self->peek_ahead( $i++ ) ) ) {
        $line =~ s/^\s+//;                 # trim leading blanks
        next if ( length($line) <= 0 );    # skip blank
        next if ( $line =~ /^#/ );         # skip comment

        # Updated from 2 to 3 to get trigraphs, added for case b1175
        my ( $rtok, $rmap_uu, $rtype_uu ) = pre_tokenize( $line, 3 );
        my $j = $max_token_index + 1;

        foreach my $tok ( @{$rtok} ) {
            last if ( $tok =~ "\n" );
            $rtokens->[ ++$j ] = $tok;
        }
        last;
    } ## end while ( defined( $line = ...))
    return;
} ## end sub peek_ahead_for_nonblank_token

#######################################################################
# Tokenizer guessing routines for ambiguous situations
#######################################################################

my %is_non_ternary_pretok;

BEGIN {

    # Some pre-tokens which cannot immediately follow a ternary '?'
    my @q = qw# ; ? : ) } ] = > #;
    push @q, COMMA;
    %is_non_ternary_pretok = map { $_ => 1 } @q;
}

sub guess_if_pattern_or_conditional {

    my ( $self, $i, $rtokens, $rtoken_type, $rtoken_map_uu, $max_token_index )
      = @_;

    # This routine is called when we have encountered a ? following an
    # unknown bareword, and we must decide if it starts a pattern or not
    # Given:
    #   $i - token index of the ? starting possible pattern
    #   $rtokens ... = the token arrays
    # Return:
    #   $is_pattern = 0 if probably not pattern,  =1 if probably a pattern
    #   msg = a warning or diagnostic message

    # USES GLOBAL VARIABLES: $last_nonblank_token

    my $is_pattern = 0;
    my $msg =
"guessing that ? after type='$last_nonblank_type' token='$last_nonblank_token' starts a ";

    if ( $i >= $max_token_index ) {
        $msg .= "conditional (no end to pattern found on the line)\n";
        $is_pattern = 0;
        return ( $is_pattern, $msg );
    }

    # See if we can rule out a ternary operator here before proceeding. c547.
    my ( $next_nonblank_token, $i_next_uu ) =
      find_next_nonblank_token_on_this_line( $i, $rtokens, $max_token_index );
    if (
        !(
            $is_non_ternary_pretok{$next_nonblank_token}
            || ( $last_nonblank_type eq 'k' && $last_nonblank_token eq 'split' )
        )
      )
    {
        # A ternary cannot be ruled out here. We will assume this is a ternary
        # operator since '?' as pattern delimiter is deprecated.
        $is_pattern = 0;
        $msg .= "conditional (cannot rule it out)";
        return ( $is_pattern, $msg );
    }

    # If we get here, then we either have a ternary with a syntax error or some
    # ancient code which uses ? as a pattern delimiter. We will only select the
    # pattern delimiter if we can find its matching closing delimiter.

    my $ibeg = $i;
    $i = $ibeg + 1;
    ##my $next_token = $rtokens->[$i];    # first token after ?

    # look for a possible ending ? on this line..
    my $in_quote        = 1;
    my $quote_depth     = 0;
    my $quote_character = EMPTY_STRING;
    my $quote_pos       = 0;
    my $quoted_string;
    (

        $i,
        $in_quote,
        $quote_character,
        $quote_pos,
        $quote_depth,
        $quoted_string,

    ) = $self->follow_quoted_string(

        $ibeg,
        $in_quote,
        $rtokens,
        $rtoken_type,
        $quote_character,
        $quote_pos,
        $quote_depth,
        $max_token_index,

    );

    if ($in_quote) {

        # we didn't find an ending ? on this line,
        # so we bias towards conditional
        $is_pattern = 0;
        $msg .= "conditional (no ending ? on this line)\n";
        return ( $is_pattern, $msg );
    }

    # we found an ending ?, so we bias towards a pattern

    # Watch out for an ending ? in quotes, like this
    #    my $case_flag = File::Spec->case_tolerant ? '(?i)' : '';
    my $s_quote = 0;
    my $d_quote = 0;
    my $colons  = 0;
    foreach my $ii ( $ibeg + 1 .. $i - 1 ) {
        my $tok = $rtokens->[$ii];
        if ( $tok eq ":" ) { $colons++ }
        if ( $tok eq "'" ) { $s_quote++ }
        if ( $tok eq '"' ) { $d_quote++ }
    }
    if ( $s_quote % 2 || $d_quote % 2 || $colons ) {
        $is_pattern = 0;
        $msg .= "conditional: found ending ? but unbalanced quote chars\n";
        return ( $is_pattern, $msg );
    }
    if ( $self->pattern_expected( $i, $rtokens, $max_token_index ) >= 0 ) {
        $is_pattern = 1;
        $msg .= "pattern (found ending ? and pattern expected)\n";
        return ( $is_pattern, $msg );
    }

    # NOTE: An ultimate decision could be made on version, since ? is a ternary
    # after version 5.22. But we may be formatting an ancient script with a
    # newer perl, and it might run on an older perl, so we cannot be certain.
    # if ($] >=5.022)  {$is_pattern=0} else { ... not sure

    $msg .= "conditional (but uncertain)\n";
    return ( $is_pattern, $msg );
} ## end sub guess_if_pattern_or_conditional

my %is_known_constant;
my %is_known_function;

BEGIN {

    # Constants like 'pi' in Trig.pm are common
    my @q = qw( pi pi2 pi4 pip2 pip4 );
    $is_known_constant{$_} = 1 for @q;

    # parenless calls of 'ok' are common
    @q = qw( ok );
    $is_known_function{$_} = 1 for @q;
} ## end BEGIN

sub guess_if_pattern_or_division {

    my ( $self, $i, $rtokens, $rtoken_type, $rtoken_map, $max_token_index ) =
      @_;

    # This routine is called when we have encountered a / following an
    # unknown bareword, and we must decide if it starts a pattern or is a
    # division.
    # Given:
    #   $i - token index of the / starting possible pattern
    #   $rtokens ... = the token arrays
    # Return:
    #   $is_pattern = 0 if probably division,  =1 if probably a pattern
    #   msg = a warning or diagnostic message
    # USES GLOBAL VARIABLES: $last_nonblank_token
    my $msg        = "guessing that / after '$last_nonblank_token' starts a ";
    my $ibeg       = $i;
    my $is_pattern = 0;

    my $divide_possible =
      $self->is_possible_numerator( $i, $rtokens, $max_token_index );

    if ( $divide_possible < 0 ) {
        $msg .= "pattern (division not possible here)\n";
        $is_pattern = 1;
        $self->saw_bareword_function($last_nonblank_token);
        return ( $is_pattern, $msg );
    }
    if ( $divide_possible == 4 ) {
        $msg .= "division (pattern not possible here)\n";
        $is_pattern = 0;
        return ( $is_pattern, $msg );
    }

    # anything left on line?
    if ( $i >= $max_token_index ) {
        $msg .= "division (line ends with this /)\n";
        $is_pattern = 0;
        return ( $is_pattern, $msg );
    }

    # quick check for no pattern-ending slash on this line
    my $pos_beg    = $rtoken_map->[$ibeg];
    my $input_line = $self->[_line_of_text_];
    if ( index( $input_line, '/', $pos_beg + 1 ) < 0 ) {
        $msg .= "division (no ending / on this line)\n";
        $is_pattern = 0;
        return ( $is_pattern, $msg );
    }

    # Setup spacing rule before we change $i below..
    $i = $ibeg + 1;
    my $next_token = $rtokens->[$i];    # first token after slash

    # There are four possible spacings around the first slash:
    #
    #     return pi/two;#/;     -/-
    #     return pi/ two;#/;    -/+
    #     return pi / two;#/;   +/+
    #     return pi /two;#/;    +/-   <-- possible pattern
    #
    # Spacing rule: a space before the slash but not after the slash
    # usually indicates a pattern.  We can use this to break ties.
    # Note: perl seems to take a newline as a space in this rule (c243)
    my $space_before          = $i < 2 || $rtokens->[ $i - 2 ] =~ m/^\s/;
    my $space_after           = $next_token                    =~ m/^\s/;
    my $is_pattern_by_spacing = $space_before && !$space_after;

    # Make an accurate search for a possible terminating / on this line..
    my $in_quote        = 1;
    my $quote_depth     = 0;
    my $quote_character = EMPTY_STRING;
    my $quote_pos       = 0;
    my $quoted_string;
    (

        $i,
        $in_quote,
        $quote_character,
        $quote_pos,
        $quote_depth,
        $quoted_string,
      )
      = $self->follow_quoted_string(

        $ibeg,
        $in_quote,
        $rtokens,
        $rtoken_type,
        $quote_character,
        $quote_pos,
        $quote_depth,
        $max_token_index,
      );

    # if we didn't find an ending / on this line ..
    if ($in_quote) {
        $is_pattern = 0;
        $msg .= "division (no ending / on this line)\n";
        return ( $is_pattern, $msg );
    }

    # we found an ending /, see if it might terminate a pattern
    my $pattern_expected =
      $self->pattern_expected( $i, $rtokens, $max_token_index );

    if ( $pattern_expected < 0 ) {
        $is_pattern = 0;
        $msg .= "division (pattern not possible)\n";
        return ( $is_pattern, $msg );
    }

    # Both pattern and divide can work here...
    # Check for known constants in the numerator, like 'pi'
    if ( $is_known_constant{$last_nonblank_token} ) {
        $msg .=
"division (pattern works too but saw known constant '$last_nonblank_token')\n";
        $is_pattern = 0;
        return ( $is_pattern, $msg );
    }

    # Check for known functions like 'ok'
    if ( $is_known_function{$last_nonblank_token} ) {
        $msg .= "pattern (division works too but saw '$last_nonblank_token')\n";
        $is_pattern = 1;
        return ( $is_pattern, $msg );
    }

    # If one rule is more probable, use it
    if ( $divide_possible > $pattern_expected ) {
        $msg .= "division (more likely based on following tokens)\n";
        $is_pattern = 0;
        return ( $is_pattern, $msg );
    }

    # finally, we have to use the spacing rule
    if ($is_pattern_by_spacing) {
        $msg .= "pattern (guess on spacing, but division possible too)\n";
        $is_pattern = 1;
    }
    else {
        $msg .= "division (guess on spacing, but pattern is possible too)\n";
        $is_pattern = 0;
    }

    return ( $is_pattern, $msg );
} ## end sub guess_if_pattern_or_division

sub guess_if_here_doc {

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

    # Try to resolve here-doc vs. shift by looking ahead for
    # non-code or the end token (currently only looks for end token)

    # Given:
    #   $next_token = the next token after '<<'

    # Return:
    #   1 if it is probably a here doc
    #   0 if not

    # USES GLOBAL VARIABLES: $current_package $ris_constant,

    # This is how many lines we will search for a target as part of the
    # guessing strategy.  There is probably little reason to change it.
    my $HERE_DOC_WINDOW = 40;

    my $here_doc_expected = 0;
    my $line;
    my $k   = 0;
    my $msg = "checking <<";

    while ( defined( $line = $self->peek_ahead( $k++ ) ) ) {
        chomp $line;
        if ( $line eq $next_token ) {
            $msg .= " -- found target $next_token ahead $k lines\n";
            $here_doc_expected = 1;    # got it
            last;
        }
        last if ( $k >= $HERE_DOC_WINDOW );
    } ## end while ( defined( $line = ...))

    if ( !$here_doc_expected ) {

        if ( !defined($line) ) {
            $here_doc_expected = -1;    # hit eof without seeing target
            $msg .= " -- must be shift; target $next_token not in file\n";
        }
        else {                          # still unsure..taking a wild guess

            if ( !$ris_constant->{$current_package}->{$next_token} ) {
                $here_doc_expected = 1;
                $msg .=
                  " -- guessing it's a here-doc ($next_token not a constant)\n";
            }
            else {
                $msg .=
                  " -- guessing it's a shift ($next_token is a constant)\n";
            }
            if (DEBUG_GUESS_MODE) {
                $self->warning("DEBUG_GUESS_MODE message:\n$msg\n");
            }
        }
    }
    $self->write_logfile_entry($msg);
    return $here_doc_expected;
} ## end sub guess_if_here_doc

#######################################################################
# Tokenizer Routines for scanning identifiers and related items
#######################################################################

sub scan_bare_identifier_do {

    my (

        $self,

        $input_line,
        $i,
        $tok,
        $type,
        $prototype,
        $rtoken_map,
        $max_token_index,

    ) = @_;

    # This routine is called to scan a token starting with an alphanumeric
    # variable or package separator, :: or '.

    # Given:
    #   current scan state variables

    # USES GLOBAL VARIABLES: $current_package, $last_nonblank_token,
    # $last_nonblank_type, $rparen_type, $paren_depth

    my $package = undef;

    my $i_beg = $i;

    # we have to back up one pretoken at a :: since each : is one pretoken
    if ( $tok eq '::' ) { $i_beg-- }
    my $pos_beg = $rtoken_map->[$i_beg];
    pos($input_line) = $pos_beg;

    #  Examples:
    #   A::B::C
    #   A::
    #   ::A
    #   A'B
    if (
        $input_line =~ m{
                  \G\s*                # start at pos
                  ( (?:\w*(?:'|::))* ) # $1 = maybe package name like A:: A::B:: or A'
                  (\w+)?               # $2 = maybe followed by sub name
                }gcx
      )
    {
        my $pos  = pos($input_line);
        my $numc = $pos - $pos_beg;
        $tok = substr( $input_line, $pos_beg, $numc );

        # type 'w' includes anything without leading type info
        # ($,%,@,*) including something like abc::def::ghi
        $type = 'w';

        my $sub_name = EMPTY_STRING;
        if ( defined($2) ) { $sub_name = $2; }
        if ( defined($1) && length($1) ) {
            $package = $1;

            # patch: check for package call A::B::C->
            # in this case, C is part of the package name
            if ($sub_name) {
                if ( $input_line =~ m{ \G\s*(?:->) }gcx ) {
                    $package .= $sub_name;
                    $sub_name = EMPTY_STRING;
                }
                pos($input_line) = $pos;
            }

            # patch: don't allow isolated package name which just ends
            # in the old style package separator (single quote).  Example:
            #   use CGI':all';
            if ( !($sub_name) && substr( $package, -1, 1 ) eq '\'' ) {
                $pos--;
            }

            $package =~ s/\'/::/g;
            if ( $package =~ /^\:/ ) { $package = 'main' . $package }
            $package =~ s/::$//;
        }
        else {
            $package = $current_package;

            # patched for c043, part 1: keyword does not follow '->'
            if ( $is_keyword{$tok} && $last_nonblank_type ne '->' ) {
                $type = 'k';
            }
        }

        # if it is a bareword..  patched for c043, part 2: not following '->'
        if ( $type eq 'w' && $last_nonblank_type ne '->' ) {

            # check for v-string with leading 'v' type character
            # (This seems to have precedence over filehandle, type 'Y')
            if ( substr( $tok, 0, 1 ) eq 'v' && $tok =~ /^v\d[_\d]*$/ ) {

                # we only have the first part - something like 'v101' -
                # look for more
                if ( $input_line =~ m/\G(\.\d[_\d]*)+/gc ) {
                    $pos  = pos($input_line);
                    $numc = $pos - $pos_beg;
                    $tok  = substr( $input_line, $pos_beg, $numc );
                }
                $type = 'v';
                $self->report_v_string($tok);
            }

            # bareword after sort has implied empty prototype; for example:
            # @sorted = sort numerically ( 53, 29, 11, 32, 7 );
            # This has priority over whatever the user has specified.
            elsif ($last_nonblank_token eq 'sort'
                && $last_nonblank_type eq 'k' )
            {
                $type = 'Z';
            }

            # issue c382: this elsif statement moved from above because
            # previous check for type 'Z' after sort has priority.
            elsif ( $ris_constant->{$package}->{$sub_name} ) {
                $type = 'C';
            }

            # Note: strangely, perl does not seem to really let you create
            # functions which act like eval and do, in the sense that eval
            # and do may have operators following the final }, but any operators
            # that you create with prototype (&) apparently do not allow
            # trailing operators, only terms.  This seems strange.
            # If this ever changes, here is the update
            # to make perltidy behave accordingly:

            # elsif ( $ris_block_function->{$package}{$tok} ) {
            #    $tok='eval'; # patch to do braces like eval  - doesn't work
            #    $type = 'k';
            #}
            # TODO: This could become a separate type to allow for different
            # future behavior:
            elsif ( $ris_block_function->{$package}->{$sub_name} ) {
                $type = 'G';
            }
            elsif ( $ris_block_list_function->{$package}->{$sub_name} ) {
                $type = 'G';
            }
            elsif ( $ris_user_function->{$package}->{$sub_name} ) {
                $type      = 'U';
                $prototype = $ruser_function_prototype->{$package}->{$sub_name};
            }

            # check for indirect object
            elsif (

                # added 2001-03-27: must not be followed immediately by '('
                # see fhandle.t
                ( $input_line !~ m/\G\(/gc )

                # and
                && (

                    # preceded by keyword like 'print', 'printf' and friends
                    $is_indirect_object_taker{$last_nonblank_token}

                    # or preceded by something like 'print(' or 'printf('
                    || (
                        ( $last_nonblank_token eq '(' )
                        && $is_indirect_object_taker{
                            $rparen_type->[$paren_depth]
                        }

                    )
                )
              )
            {

                # may not be indirect object unless followed by a space;
                # updated 2021-01-16 to consider newline to be a space.
                # updated for case b990 to look for either ';' or space
                if ( pos($input_line) == length($input_line)
                    || $input_line =~ m/\G[;\s]/gc )
                {
                    $type = 'Y';

                    # Abandon Hope ...
                    # Perl's indirect object notation is a very bad
                    # thing and can cause subtle bugs, especially for
                    # beginning programmers.  And I haven't even been
                    # able to figure out a sane warning scheme which
                    # doesn't get in the way of good scripts.

                    # Complain if a filehandle has any lower case
                    # letters.  This is suggested good practice.
                    # Use 'sub_name' because something like
                    # main::MYHANDLE is ok for filehandle
                    if ( $sub_name =~ /[a-z]/ ) {

                        # could be bug caused by older perltidy if
                        # followed by '('
                        if ( $input_line =~ m/\G\s*\(/gc ) {
                            $self->complain(
"Caution: unknown word '$tok' in indirect object slot\n"
                            );
                        }
                    }
                }

                # bareword not followed by a space -- may not be filehandle
                # (may be function call defined in a 'use' statement)
                else {
                    $type = 'Z';
                }
            }
            else {
                ## none of the above special types
            }
        }

        # Now we must convert back from character position
        # to pre_token index.
        # I don't think an error flag can occur here ..but who knows
        my $error;
        ( $i, $error ) =
          inverse_pretoken_map( $i, $pos, $rtoken_map, $max_token_index );
        if ($error) {
            $self->warning(
                "scan_bare_identifier: Possibly invalid tokenization\n");
        }
    }

    # no match but line not blank - could be syntax error
    # perl will take '::' alone without complaint
    else {
        $type = 'w';

        # change this warning to log message if it becomes annoying
        $self->warning("didn't find identifier after leading ::\n");
    }
    return ( $i, $tok, $type, $prototype );
} ## end sub scan_bare_identifier_do

sub scan_id_do {

    my (

        $self,

        $input_line,
        $i,
        $tok,
        $rtokens,
        $rtoken_map,
        $id_scan_state,
        $max_token_index,

    ) = @_;

    # Scan identifier following a type token.
    # Given:
    #   current scan state variables

    # This is the new scanner and may eventually replace scan_identifier.
    # Only type 'sub' and 'package' are implemented.
    # Token types $ * % @ & -> are not yet implemented.
    #
    # The type of call depends on $id_scan_state: $id_scan_state = ''
    # for starting call, in which case $tok must be the token defining
    # the type.
    #
    # If the type token is the last nonblank token on the line, a value
    # of $id_scan_state = $tok is returned, indicating that further
    # calls must be made to get the identifier.  If the type token is
    # not the last nonblank token on the line, the identifier is
    # scanned and handled and a value of '' is returned.

    use constant DEBUG_NSCAN => 0;
    my $type = EMPTY_STRING;
    my $i_beg;

    #print "NSCAN:entering i=$i, tok=$tok, type=$type, state=$id_scan_state\n";
    #my ($a,$b,$c) = caller;
    #print "NSCAN: scan_id called with tok=$tok $a $b $c\n";

    # on re-entry, start scanning at first token on the line
    if ($id_scan_state) {
        $i_beg = $i;
        $type  = EMPTY_STRING;
    }

    # on initial entry, start scanning just after type token
    else {
        $i_beg         = $i + 1;
        $id_scan_state = $tok;
        $type          = 't';
    }

    # find $i_beg = index of next nonblank token,
    # and handle empty lines
    my $blank_line          = 0;
    my $is_lexical_method   = 0;
    my $next_nonblank_token = $rtokens->[$i_beg];
    if ( $i_beg > $max_token_index ) {
        $blank_line = 1;
    }
    else {

        # only a '#' immediately after a '$' is not a comment
        if ( $next_nonblank_token eq '#' ) {
            if ( $tok ne '$' ) {
                $blank_line = 1;
            }
        }

        if ( $next_nonblank_token =~ /^\s/ ) {
            ( $next_nonblank_token, $i_beg ) =
              find_next_nonblank_token_on_this_line( $i_beg, $rtokens,
                $max_token_index );
            if ( $next_nonblank_token =~ /(^#|^\s*$)/ ) {
                $blank_line = 1;
            }
        }

        # Patch for Object::Pad lexical method like 'method $var {':
        # Skip past a '$'
        if (  !$blank_line
            && $next_nonblank_token eq '$'
            && $id_scan_state eq 'method' )
        {
            ( $next_nonblank_token, $i_beg ) =
              find_next_nonblank_token_on_this_line( $i_beg, $rtokens,
                $max_token_index );
            $is_lexical_method = 1;
        }
    }

    # handle non-blank line; identifier, if any, must follow
    if ( !$blank_line ) {

        if ( $is_sub{$id_scan_state} ) {
            ( $i, $tok, $type, $id_scan_state ) = $self->do_scan_sub(
                {
                    input_line        => $input_line,
                    i                 => $i,
                    i_beg             => $i_beg,
                    tok               => $tok,
                    type              => $type,
                    rtokens           => $rtokens,
                    rtoken_map        => $rtoken_map,
                    id_scan_state     => $id_scan_state,
                    max_token_index   => $max_token_index,
                    is_lexical_method => $is_lexical_method,
                }
            );
        }

        elsif ( $is_package{$id_scan_state} ) {
            ( $i, $tok, $type ) = $self->do_scan_package(
                {
                    input_line      => $input_line,
                    i               => $i,
                    i_beg           => $i_beg,
                    tok             => $tok,
                    type            => $type,
                    rtokens         => $rtokens,
                    rtoken_map      => $rtoken_map,
                    max_token_index => $max_token_index,
                }
            );
            $id_scan_state = EMPTY_STRING;
        }

        else {
            $self->warning("invalid token in scan_id: $tok\n");
            $id_scan_state = EMPTY_STRING;
        }
    }

    if ( $id_scan_state && ( !defined($type) || !$type ) ) {

        # shouldn't happen:
        if (DEVEL_MODE) {
            Fault(<<EOM);
Program bug in scan_id: undefined type but scan_state=$id_scan_state
EOM
        }
        $self->warning(
"Possible program bug in sub scan_id: undefined type but scan_state=$id_scan_state\n"
        );
        $self->report_definite_bug();
    }

    DEBUG_NSCAN && do {
        print {*STDOUT}
          "NSCAN: returns i=$i, tok=$tok, type=$type, state=$id_scan_state\n";
    };
    return ( $i, $tok, $type, $id_scan_state );
} ## end sub scan_id_do

sub check_prototype {
    my ( $proto, $package, $subname ) = @_;

    # Classify a sub based on its prototype
    return if ( !defined($package) );
    return if ( !defined($subname) );
    if ( defined($proto) ) {
        $proto =~ s/^\s*\(\s*//;
        $proto =~ s/\s*\)$//;
        if ($proto) {
            $ris_user_function->{$package}->{$subname}        = 1;
            $ruser_function_prototype->{$package}->{$subname} = "($proto)";

            # prototypes containing '&' must be treated specially..
            if ( $proto =~ /\&/ ) {

                # right curly braces of prototypes ending in
                # '&' may be followed by an operator
                if ( $proto =~ /\&$/ ) {
                    $ris_block_function->{$package}->{$subname} = 1;
                }

                # right curly braces of prototypes NOT ending in
                # '&' may NOT be followed by an operator
                else {
                    $ris_block_list_function->{$package}->{$subname} = 1;
                }
            }
        }
        else {
            $ris_constant->{$package}->{$subname} = 1;
        }
    }
    else {
        $ris_user_function->{$package}->{$subname} = 1;
    }
    return;
} ## end sub check_prototype

sub do_scan_package {

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

    # Parse a package name.

    my $input_line      = $rcall_hash->{input_line};
    my $i               = $rcall_hash->{i};
    my $i_beg           = $rcall_hash->{i_beg};
    my $tok             = $rcall_hash->{tok};
    my $type            = $rcall_hash->{type};
    my $rtokens         = $rcall_hash->{rtokens};
    my $rtoken_map      = $rcall_hash->{rtoken_map};
    my $max_token_index = $rcall_hash->{max_token_index};

    # This is called with $i_beg equal to the index of the first nonblank
    # token following a 'package' token.
    # USES GLOBAL VARIABLES: $current_package,

    # package NAMESPACE
    # package NAMESPACE VERSION
    # package NAMESPACE BLOCK
    # package NAMESPACE VERSION BLOCK
    #
    # If VERSION is provided, package sets the $VERSION variable in the given
    # namespace to a version object with the VERSION provided. VERSION must be
    # a "strict" style version number as defined by the version module: a
    # positive decimal number (integer or decimal-fraction) without
    # exponentiation or else a dotted-decimal v-string with a leading 'v'
    # character and at least three components.
    # reference http://perldoc.perl.org/functions/package.html

    my $package = undef;
    my $pos_beg = $rtoken_map->[$i_beg];
    pos($input_line) = $pos_beg;

    # handle non-blank line; package name, if any, must follow
    if ( $input_line =~ m/\G\s*((?:\w*(?:'|::))*\w*)/gc ) {
        $package = $1;
        $package = ( defined($1) && $1 ) ? $1 : 'main';
        $package =~ s/\'/::/g;
        if ( $package =~ /^\:/ ) { $package = 'main' . $package }
        $package =~ s/::$//;
        my $pos  = pos($input_line);
        my $numc = $pos - $pos_beg;
        $tok  = 'package ' . substr( $input_line, $pos_beg, $numc );
        $type = 'P';    # Fix for c250, previously 'i'

        # Now we must convert back from character position
        # to pre_token index.
        # I don't think an error flag can occur here ..but ?
        my $error;
        ( $i, $error ) =
          inverse_pretoken_map( $i, $pos, $rtoken_map, $max_token_index );
        if ($error) { $self->warning("Possibly invalid package\n") }
        $current_package = $package;

        # we should now have package NAMESPACE
        # now expecting VERSION, BLOCK, or ; to follow ...
        # package NAMESPACE VERSION
        # package NAMESPACE BLOCK
        # package NAMESPACE VERSION BLOCK
        my ( $next_nonblank_token, $i_next_uu ) =
          $self->find_next_nonblank_token( $i, $rtokens, $max_token_index );

        # check that something recognizable follows, but do not parse.
        # A VERSION number will be parsed later as a number or v-string in the
        # normal way.  What is important is to set the statement type if
        # everything looks okay so that the operator_expected() routine
        # knows that the number is in a package statement.
        # Examples of valid primitive tokens that might follow are:
        #  1235  . ; { } v3  v
        # FIX: added a '#' since a side comment may also follow
        # Added ':' for class attributes (for --use-feature=class, rt145706)
        if ( $next_nonblank_token =~ /^([v\.\d;\{\}\#\:])|v\d|\d+$/ ) {
            $statement_type = $tok;
        }
        else {
            $self->warning(
                "Unexpected '$next_nonblank_token' after package name '$tok'\n"
            );
        }
    }

    # no match but line not blank --
    # could be a label with name package, like package:  , for example.
    else {
        $type = 'k';
    }

    return ( $i, $tok, $type );
} ## end sub do_scan_package

{    ## begin closure for sub scan_complex_identifier

    use constant DEBUG_SCAN_ID => 0;

    # Constant hash:
    my %is_special_variable_char;

    BEGIN {

        # These are the only characters which can (currently) form special
        # variables, like $^W: (issue c066).
        my @q = qw{
          ? A B C D E F G H I J K L M N O P Q R S T U V W X Y Z [ ] ^ _
        };
        push @q, BACKSLASH;
        $is_special_variable_char{$_} = 1 for @q;
    } ## end BEGIN

    # These are the possible states for this scanner:
    my $scan_state_SIGIL     = '$';
    my $scan_state_ALPHA     = 'A';
    my $scan_state_COLON     = ':';
    my $scan_state_LPAREN    = '(';
    my $scan_state_RPAREN    = ')';
    my $scan_state_AMPERSAND = '&';
    my $scan_state_SPLIT     = '^';

    # Only these non-blank states may be returned to caller:
    my %is_returnable_scan_state = (
        $scan_state_SIGIL     => 1,
        $scan_state_AMPERSAND => 1,
    );

    # USES GLOBAL VARIABLES:
    #    $context, $last_nonblank_token, $last_nonblank_type

    #-----------
    # call args:
    #-----------
    my ( $i, $id_scan_state, $identifier, $rtokens, $max_token_index,
        $expecting, $container_type );

    #-------------------------------------------
    # my variables, re-initialized on each call:
    #-------------------------------------------
    my $i_begin;                # starting index $i
    my $type;                   # returned identifier type
    my $tok_begin;              # starting token
    my $tok;                    # returned token
    my $id_scan_state_begin;    # starting scan state
    my $identifier_begin;       # starting identifier
    my $i_save;                 # a last good index, in case of error
    my $message;                # hold error message for log file
    my $tok_is_blank;
    my $last_tok_is_blank;
    my $in_prototype_or_signature;
    my $saw_alpha;
    my $saw_type;
    my $allow_tick;

    sub initialize_my_scan_id_vars {

        # Initialize all 'my' vars on entry
        $i_begin   = $i;
        $type      = EMPTY_STRING;
        $tok_begin = $rtokens->[$i_begin];
        $tok       = $tok_begin;
        if ( $tok_begin eq ':' ) { $tok_begin = '::' }
        $id_scan_state_begin = $id_scan_state;
        $identifier_begin    = $identifier;
        $i_save              = undef;

        $message           = EMPTY_STRING;
        $tok_is_blank      = undef;          # a flag to speed things up
        $last_tok_is_blank = undef;

        $in_prototype_or_signature =
          $container_type && $container_type =~ /^sub\b/;

        # these flags will be used to help figure out the type:
        $saw_alpha = undef;
        $saw_type  = undef;

        # allow old package separator (') except in 'use' statement
        $allow_tick = ( $last_nonblank_token ne 'use' );
        return;
    } ## end sub initialize_my_scan_id_vars

    #----------------------------------
    # Routines for handling scan states
    #----------------------------------
    sub do_id_scan_state_dollar {

        my $self = shift;

        # We saw a sigil, now looking to start a variable name
        if ( $tok eq '$' ) {

            $identifier .= $tok;

            # we've got a punctuation variable if end of line (punct.t)
            if ( $i == $max_token_index ) {
                $type          = 'i';
                $id_scan_state = EMPTY_STRING;
            }
        }
        elsif ( $tok =~ /^\w/ ) {    # alphanumeric ..
            $saw_alpha = 1;
            $identifier .= $tok;

            # now need :: except for special digit vars like '$1' (c208)
            $id_scan_state = $tok =~ /^\d/ ? EMPTY_STRING : $scan_state_COLON;
        }
        elsif ( $tok eq '::' ) {
            $id_scan_state = $scan_state_ALPHA;
            $identifier .= $tok;
        }

        # POSTDEFREF ->@ ->% ->& ->*
        elsif ( ( $tok =~ /^[\@\%\&\*]$/ ) && $identifier =~ /\-\>$/ ) {
            $identifier .= $tok;
        }
        elsif ( $tok eq "'" && $allow_tick ) {    # alphanumeric ..
            $saw_alpha     = 1;
            $id_scan_state = $scan_state_COLON;    # now need ::
            $identifier .= $tok;

            # Perl will accept leading digits in identifiers,
            # although they may not always produce useful results.
            # Something like $main::0 is ok.  But this also works:
            #
            #  sub howdy::123::bubba{ print "bubba $54321!\n" }
            #  howdy::123::bubba();
            #
        }
        elsif ( $tok eq '#' ) {

            my $is_punct_var = $identifier eq '$$';

            # side comment or identifier?
            if (

                # A '#' starts a comment if it follows a space. For example,
                # the following is equivalent to $ans=40.
                #   my $ #
                #     ans = 40;
                !$last_tok_is_blank

                # a # inside a prototype or signature can only start a
                # comment
                && !$in_prototype_or_signature

                # these are valid punctuation vars: *# %# @# $#
                # May also be '$#array' or POSTDEFREF ->$#
                && (   $identifier =~ /^[\%\@\$\*]$/
                    || $identifier =~ /\$$/ )

                # but a '#' after '$$' is a side comment; see c147
                && !$is_punct_var

              )
            {
                $identifier .= $tok;    # keep same state, a $ could follow
            }
            else {

                # otherwise it is a side comment
                if    ( $identifier eq '->' )                 { }
                elsif ($is_punct_var)                         { $type = 'i' }
                elsif ( $id_scan_state eq $scan_state_SIGIL ) { $type = 't' }
                else                                          { $type = 'i' }
                $i             = $i_save;
                $id_scan_state = EMPTY_STRING;
            }
        }

        elsif ( $tok eq '{' ) {

            # check for something like ${#} or ${?}, where ? is a special char
            if (
                (
                       $identifier eq '$'
                    || $identifier eq '@'
                    || $identifier eq '$#'
                )
                && $i + 2 <= $max_token_index
                && $rtokens->[ $i + 2 ] eq '}'
                && $rtokens->[ $i + 1 ] !~ /[\s\w]/
              )
            {
                my $next2 = $rtokens->[ $i + 2 ];
                my $next1 = $rtokens->[ $i + 1 ];
                $identifier .= $tok . $next1 . $next2;
                $i += 2;
                $id_scan_state = EMPTY_STRING;
            }
            else {

                # skip something like ${xxx} or ->{
                $id_scan_state = EMPTY_STRING;

                # if this is the first token of a line, any tokens for this
                # identifier have already been accumulated
                if ( $identifier eq '$' || $i == 0 ) {
                    $identifier = EMPTY_STRING;
                }
                $i = $i_save;
            }
        }

        # space ok after leading $ % * & @
        elsif ( $tok =~ /^\s*$/ ) {

            $tok_is_blank = 1;

            # note: an id with a leading '&' does not actually come this way
            if ( $identifier =~ /^[\$\%\*\&\@]/ ) {

                if ( length($identifier) > 1 ) {
                    $id_scan_state = EMPTY_STRING;
                    $i             = $i_save;
                    $type          = 'i';    # probably punctuation variable
                }
                else {

                    # fix c139: trim line-ending type 't'
                    if ( $i == $max_token_index ) {
                        $i    = $i_save;
                        $type = 't';
                    }

                    # spaces after $'s are common, and space after @
                    # is harmless, so only complain about space
                    # after other type characters. Space after $ and
                    # @ will be removed in formatting.  Report space
                    # after % and * because they might indicate a
                    # parsing error.  In other words '% ' might be a
                    # modulo operator.  Delete this warning if it
                    # gets annoying.
                    elsif ( $identifier !~ /^[\@\$]$/ ) {
                        $message =
                          "Space in identifier, following $identifier\n";
                    }
                    else {
                        ## silently accept space after '$' and '@' sigils
                    }
                }
            }

            elsif ( $identifier eq '->' ) {

                # space after '->' is ok except at line end ..
                # so trim line-ending in type '->' (fixes c139)
                if ( $i == $max_token_index ) {
                    $i    = $i_save;
                    $type = '->';
                }
            }

            # stop at space after something other than -> or sigil
            # Example of what can arrive here:
            #   eval { $MyClass->$$ };
            else {
                $id_scan_state = EMPTY_STRING;
                $i             = $i_save;
                $type          = 'i';
            }
        }
        elsif ( $tok eq '^' ) {

            # check for some special variables like $^ $^W
            if ( $identifier =~ /^[\$\*\@\%]$/ ) {
                $identifier .= $tok;
                $type = 'i';

                # There may be one more character, not a space, after the ^
                my $next1 = $rtokens->[ $i + 1 ];
                my $chr   = substr( $next1, 0, 1 );
                if ( $is_special_variable_char{$chr} ) {

                    # It is something like $^W
                    # Test case (c066) : $^Oeq'linux'
                    $i++;
                    $identifier .= $next1;

                    # If pretoken $next1 is more than one character long,
                    # set a flag indicating that it needs to be split.
                    $id_scan_state =
                      ( length($next1) > 1 ) ? $scan_state_SPLIT : EMPTY_STRING;
                }
                else {

                    # it is just $^
                    # Simple test case (c065): '$aa=$^if($bb)';
                    $id_scan_state = EMPTY_STRING;
                }
            }
            else {
                $id_scan_state = EMPTY_STRING;
                $i             = $i_save;
            }
        }
        else {    # something else

            if ( $in_prototype_or_signature && $tok =~ /^[\),=#]/ ) {

                # We might be in an extrusion of
                #     sub foo2 ( $first, $, $third ) {
                # looking at a line starting with a comma, like
                #   $
                #   ,
                # in this case the comma ends the signature variable
                # '$' which will have been previously marked type 't'
                # rather than 'i'.
                if ( $i == $i_begin ) {
                    $identifier = EMPTY_STRING;
                    $type       = EMPTY_STRING;
                }

                # at a # we have to mark as type 't' because more may
                # follow, otherwise, in a signature we can let '$' be an
                # identifier here for better formatting.
                # See 'mangle4.in' for a test case.
                else {
                    $type = 'i';
                    if ( $id_scan_state eq $scan_state_SIGIL && $tok eq '#' ) {
                        $type = 't';
                    }
                    $i = $i_save;
                }
                $id_scan_state = EMPTY_STRING;
            }

            # check for various punctuation variables
            elsif ( $identifier =~ /^[\$\*\@\%]$/ ) {
                $identifier .= $tok;
            }

            # POSTDEFREF: Postfix reference ->$* ->%*  ->@* ->** ->&* ->$#*
            elsif ($tok eq '*'
                && $identifier =~ /\-\>([\@\%\$\*\&]|\$\#)$/ )
            {
                $identifier .= $tok;
            }

            elsif ( $identifier eq '$#' ) {

                if ( $tok eq '{' ) { $type = 'i'; $i = $i_save }

                # perl seems to allow just these: $#: $#- $#+
                elsif ( $tok =~ /^[\:\-\+]$/ ) {
                    $type = 'i';
                    $identifier .= $tok;
                }
                else {
                    $i = $i_save;
                    $self->write_logfile_entry(
                        'Use of $# is deprecated' . "\n" );
                }
            }
            elsif ( $identifier eq '$$' ) {

                # perl does not allow references to punctuation
                # variables without braces.  For example, this
                # won't work:
                #  $:=\4;
                #  $a = $$:;
                # You would have to use
                #  $a = ${$:};

                # '$$' alone is punctuation variable for PID
                $i = $i_save;
                if   ( $tok eq '{' ) { $type = 't' }
                else                 { $type = 'i' }
            }
            elsif ( $identifier eq '->' ) {
                $i = $i_save;
            }
            else {
                $i = $i_save;
                if ( length($identifier) == 1 ) {
                    $identifier = EMPTY_STRING;
                }
            }
            $id_scan_state = EMPTY_STRING;
        }
        return;
    } ## end sub do_id_scan_state_dollar

    sub do_id_scan_state_alpha {

        my $self = shift;

        # looking for alphanumeric after ::
        $tok_is_blank = $tok =~ /^\s*$/;

        if ( $tok =~ /^\w/ ) {    # found it
            $identifier .= $tok;
            $id_scan_state = $scan_state_COLON;    # now need ::
            $saw_alpha     = 1;
        }
        elsif ( $tok eq "'" && $allow_tick ) {
            $identifier .= $tok;
            $id_scan_state = $scan_state_COLON;    # now need ::
            $saw_alpha     = 1;
        }
        elsif ( $tok_is_blank && $identifier =~ /^sub / ) {
            $id_scan_state = $scan_state_LPAREN;
            $identifier .= $tok;
        }
        elsif ( $tok eq '(' && $identifier =~ /^sub / ) {
            $id_scan_state = $scan_state_RPAREN;
            $identifier .= $tok;
        }
        else {
            $id_scan_state = EMPTY_STRING;
            $i             = $i_save;
        }
        return;
    } ## end sub do_id_scan_state_alpha

    sub do_id_scan_state_colon {

        my $self = shift;

        # looking for possible :: after alphanumeric

        $tok_is_blank = $tok =~ /^\s*$/;

        if ( $tok eq '::' ) {    # got it
            $identifier .= $tok;
            $id_scan_state = $scan_state_ALPHA;    # now require alpha
        }
        elsif ( $tok =~ /^\w/ ) {    # more alphanumeric is ok here
            $identifier .= $tok;
            $id_scan_state = $scan_state_COLON;    # now need ::
            $saw_alpha     = 1;
        }
        elsif ( $tok eq "'" && $allow_tick ) {     # tick

            if ( $is_keyword{$identifier} ) {
                $id_scan_state = EMPTY_STRING;     # that's all
                $i             = $i_save;
            }
            else {
                $identifier .= $tok;
            }
        }
        elsif ( $tok_is_blank && $identifier =~ /^sub / ) {
            $id_scan_state = $scan_state_LPAREN;
            $identifier .= $tok;
        }
        elsif ( $tok eq '(' && $identifier =~ /^sub / ) {
            $id_scan_state = $scan_state_RPAREN;
            $identifier .= $tok;
        }
        else {
            $id_scan_state = EMPTY_STRING;    # that's all
            $i             = $i_save;
        }
        return;
    } ## end sub do_id_scan_state_colon

    sub do_id_scan_state_left_paren {

        my $self = shift;

        # looking for possible '(' of a prototype

        if ( $tok eq '(' ) {    # got it
            $identifier .= $tok;
            $id_scan_state = $scan_state_RPAREN;    # now find the end of it
        }
        elsif ( $tok =~ /^\s*$/ ) {                 # blank - keep going
            $identifier .= $tok;
            $tok_is_blank = 1;
        }
        else {
            $id_scan_state = EMPTY_STRING;          # that's all - no prototype
            $i             = $i_save;
        }
        return;
    } ## end sub do_id_scan_state_left_paren

    sub do_id_scan_state_right_paren {

        my $self = shift;

        # looking for a ')' of prototype to close a '('

        $tok_is_blank = $tok =~ /^\s*$/;

        if ( $tok eq ')' ) {    # got it
            $identifier .= $tok;
            $id_scan_state = EMPTY_STRING;    # all done
        }
        elsif ( $tok =~ /^[\s\$\%\\\*\@\&\;]/ ) {
            $identifier .= $tok;
        }
        else {    # probable error in script, but keep going
            $self->warning(
                "Unexpected '$tok' while seeking end of prototype\n");
            $identifier .= $tok;
        }
        return;
    } ## end sub do_id_scan_state_right_paren

    sub do_id_scan_state_ampersand {

        my $self = shift;

        # Starting sub call after seeing an '&'
        if ( $tok =~ /^[\$\w]/ ) {    # alphanumeric ..
            $id_scan_state = $scan_state_COLON;    # now need ::
            $saw_alpha     = 1;
            $identifier .= $tok;
        }
        elsif ( $tok eq "'" && $allow_tick ) {     # alphanumeric ..
            $id_scan_state = $scan_state_COLON;    # now need ::
            $saw_alpha     = 1;
            $identifier .= $tok;
        }
        elsif ( $tok =~ /^\s*$/ ) {                # allow space
            $tok_is_blank = 1;

            # fix c139: trim line-ending type 't'
            if ( length($identifier) == 1 && $i == $max_token_index ) {
                $i    = $i_save;
                $type = 't';
            }
        }
        elsif ( $tok eq '::' ) {                   # leading ::
            $id_scan_state = $scan_state_ALPHA;    # accept alpha next
            $identifier .= $tok;
        }
        elsif ( $tok eq '{' ) {
            if ( $identifier eq '&' || $i == 0 ) {
                $identifier = EMPTY_STRING;
            }
            $i             = $i_save;
            $id_scan_state = EMPTY_STRING;
        }
        elsif ( $tok eq '^' ) {
            if ( $identifier eq '&' ) {

                # Special variable (c066)
                $identifier .= $tok;
                $type = 'i';

                # To be a special $^ variable, there may be one more character,
                # not a space, after the ^
                my $next1 = $rtokens->[ $i + 1 ];
                my $chr   = substr( $next1, 0, 1 );
                if ( $is_special_variable_char{$chr} ) {

                    # It is something like &^O
                    $i++;
                    $identifier .= $next1;

                    # If pretoken $next1 is more than one character long,
                    # set a flag indicating that it needs to be split.
                    $id_scan_state =
                      ( length($next1) > 1 ) ? $scan_state_SPLIT : EMPTY_STRING;
                }
                else {

                    # It is &^.  This is parsed by perl as a call to sub '^',
                    # even though it would be difficult to create a sub '^'.
                    # So we mark it as an identifier (c068).
                    $id_scan_state = EMPTY_STRING;
                }
            }
            else {
                $identifier = EMPTY_STRING;
                $i          = $i_save;
            }
        }
        else {

            # punctuation variable?
            # testfile: cunningham4.pl
            #
            # We have to be careful here.  If we are in an unknown state,
            # we will reject the punctuation variable.  In the following
            # example the '&' is a binary operator but we are in an unknown
            # state because there is no sigil on 'Prima', so we don't
            # know what it is.  But it is a bad guess that
            # '&~' is a function variable.
            # $self->{text}->{colorMap}->[
            #   Prima::PodView::COLOR_CODE_FOREGROUND
            #   & ~tb::COLOR_INDEX ] =
            #   $sec->{ColorCode}

            # Fix for case c033: a '#' here starts a side comment
            if ( $identifier eq '&' && $expecting && $tok ne '#' ) {
                $identifier .= $tok;
            }
            else {
                $identifier = EMPTY_STRING;
                $i          = $i_save;
                $type       = '&';
            }
            $id_scan_state = EMPTY_STRING;
        }
        return;
    } ## end sub do_id_scan_state_ampersand

    #-------------------
    # hash of scanner subs
    #-------------------
    my $scan_identifier_code = {
        $scan_state_SIGIL     => \&do_id_scan_state_dollar,
        $scan_state_ALPHA     => \&do_id_scan_state_alpha,
        $scan_state_COLON     => \&do_id_scan_state_colon,
        $scan_state_LPAREN    => \&do_id_scan_state_left_paren,
        $scan_state_RPAREN    => \&do_id_scan_state_right_paren,
        $scan_state_AMPERSAND => \&do_id_scan_state_ampersand,
    };

    sub scan_complex_identifier {

        (
            my $self,

            $i,
            $id_scan_state,
            $identifier,
            $rtokens,
            $max_token_index,
            $expecting,
            $container_type,

        ) = @_;

        # This routine assembles tokens into identifiers.  It maintains a
        # scan state, id_scan_state.  It updates id_scan_state based upon
        # current id_scan_state and token, and returns an updated
        # id_scan_state and the next index after the identifier.

        # This routine now serves a backup for sub scan_simple_identifier
        # which handles most identifiers.

        # Note that $self must be a 'my' variable and not be a closure
        # variables like the other args. Otherwise it will not get
        # deleted by a DESTROY call at the end of a file. Then an
        # attempt to create multiple tokenizers can occur when multiple
        # files are processed, causing an error.

        # return flag telling caller to split the pretoken
        my $split_pretoken_flag;

        #-------------------
        # Initialize my vars
        #-------------------

        initialize_my_scan_id_vars();

        #--------------------------------------------------------
        # get started by defining a type and a state if necessary
        #--------------------------------------------------------

        if ( !$id_scan_state ) {
            $context = UNKNOWN_CONTEXT;

            # fixup for digraph
            if ( $tok eq '>' ) {
                $tok       = '->';
                $tok_begin = $tok;
            }
            $identifier = $tok;

            if ( $last_nonblank_token eq '->' ) {
                $identifier    = '->' . $identifier;
                $id_scan_state = $scan_state_SIGIL;
            }
            elsif ( $tok eq '$' || $tok eq '*' ) {
                $id_scan_state = $scan_state_SIGIL;
                $context       = SCALAR_CONTEXT;
            }
            elsif ( $tok eq '%' || $tok eq '@' ) {
                $id_scan_state = $scan_state_SIGIL;
                $context       = LIST_CONTEXT;
            }
            elsif ( $tok eq '&' ) {
                $id_scan_state = $scan_state_AMPERSAND;
            }
            elsif ( $tok eq 'sub' or $tok eq 'package' ) {
                $saw_alpha     = 0;    # 'sub' is considered type info here
                $id_scan_state = $scan_state_SIGIL;
                $identifier .=
                  SPACE;    # need a space to separate sub from sub name
            }
            elsif ( $tok eq '::' ) {
                $id_scan_state = $scan_state_ALPHA;
            }
            elsif ( $tok =~ /^\w/ ) {
                $id_scan_state = $scan_state_COLON;
                $saw_alpha     = 1;
            }
            elsif ( $tok eq '->' ) {
                $id_scan_state = $scan_state_SIGIL;
            }
            else {

                # shouldn't happen: bad call parameter
                my $msg =
"Program bug detected: scan_complex_identifier received bad starting token = '$tok'\n";
                if (DEVEL_MODE) { Fault($msg) }
                if ( !$self->[_in_error_] ) {
                    $self->warning($msg);
                    $self->[_in_error_] = 1;
                }
                $id_scan_state = EMPTY_STRING;

                # emergency return
                goto SCAN_ID_EMERGENCY_RETURN;
            }
            $saw_type = !$saw_alpha;
        }
        else {
            $i--;
            $saw_alpha = ( $tok =~ /^\w/ );
            $saw_type  = ( $tok =~ /([\$\%\@\*\&])/ );

            # check for a valid starting state
            if ( DEVEL_MODE && !$is_returnable_scan_state{$id_scan_state} ) {
                Fault(<<EOM);
Unexpected starting scan state in sub scan_complex_identifier: '$id_scan_state'
EOM
            }
        }

        #------------------------------
        # loop to gather the identifier
        #------------------------------

        $i_save = $i;

        while ( $i < $max_token_index && $id_scan_state ) {

            # Be sure we have code to handle this state before we proceed
            my $code = $scan_identifier_code->{$id_scan_state};
            if ( !$code ) {

                if ( $id_scan_state eq $scan_state_SPLIT ) {
                    ## OK: this is the signal to exit and split the pretoken
                }

                # unknown state - should not happen
                else {
                    if (DEVEL_MODE) {
                        Fault(<<EOM);
Unknown scan state in sub scan_complex_identifier: '$id_scan_state'
Scan state at sub entry was '$id_scan_state_begin'
EOM
                    }
                    $id_scan_state = EMPTY_STRING;
                    $i             = $i_save;
                }
                last;
            }

            # Remember the starting index for progress check below
            my $i_start_loop = $i;

            $last_tok_is_blank = $tok_is_blank;
            if   ($tok_is_blank) { $tok_is_blank = undef }
            else                 { $i_save       = $i }

            $tok = $rtokens->[ ++$i ];

            # patch to make digraph :: if necessary
            if ( ( $tok eq ':' ) && ( $rtokens->[ $i + 1 ] eq ':' ) ) {
                $tok = '::';
                $i++;
            }

            $code->($self);

            # check for forward progress: a decrease in the index $i
            # implies that scanning has finished
            last if ( $i <= $i_start_loop );

        } ## end while ( $i < $max_token_index...)

        #-------------
        # Check result
        #-------------

        # Be sure a valid state is returned
        if ($id_scan_state) {

            if ( !$is_returnable_scan_state{$id_scan_state} ) {

                if ( $id_scan_state eq $scan_state_SPLIT ) {
                    $split_pretoken_flag = 1;
                }

                if ( $id_scan_state eq $scan_state_RPAREN ) {
                    $self->warning(
                        "Hit end of line while seeking ) to end prototype\n");
                }

                $id_scan_state = EMPTY_STRING;
            }

            # Patch: the deprecated variable $# does not combine with anything
            # on the next line.
            if ( $identifier eq '$#' ) { $id_scan_state = EMPTY_STRING }
        }

        # Be sure the token index is valid
        if ( $i < 0 ) { $i = 0 }

        # Be sure a token type is defined
        if ( !$type ) {

            if ($saw_type) {

                if ($saw_alpha) {

                  # The type without the -> should be the same as with the -> so
                  # that if they get separated we get the same bond strengths,
                  # etc.  See b1234
                    if (   $identifier =~ /^->/
                        && $last_nonblank_type eq 'w'
                        && substr( $identifier, 2, 1 ) =~ /^\w/ )
                    {
                        $type = 'w';
                    }
                    else { $type = 'i' }
                }
                elsif ( $identifier eq '->' ) {
                    $type = '->';
                }
                elsif (
                    ( length($identifier) > 1 )

                    # In something like '@$=' we have an identifier '@$'
                    # In something like '$${' we have type '$$' (and only
                    # part of an identifier)
                    && !( $identifier =~ /\$$/ && $tok eq '{' )
                    && $identifier ne 'sub '
                    && $identifier ne 'package '
                  )
                {
                    $type = 'i';
                }
                else { $type = 't' }
            }
            elsif ($saw_alpha) {

                # type 'w' includes anything without leading type info
                # ($,%,@,*) including something like abc::def::ghi
                $type = 'w';

                # Fix for b1337, if restarting scan after line break between
                # '->' or sigil and identifier name, use type 'i'
                if (   $id_scan_state_begin
                    && $identifier =~ /^([\$\%\@\*\&]|->)/ )
                {
                    $type = 'i';
                }
            }
            else {
                $type = EMPTY_STRING;
            }    # this can happen on a restart
        }

        # See if we formed an identifier...
        if ($identifier) {
            $tok = $identifier;
            if ($message) { $self->write_logfile_entry($message) }
        }

        # did not find an identifier, back  up
        else {
            $tok = $tok_begin;
            $i   = $i_begin;
        }

      SCAN_ID_EMERGENCY_RETURN:

        DEBUG_SCAN_ID && do {
            my ( $a, $b, $c ) = caller();
            print {*STDOUT}
"SCANID: called from $a $b $c with tok, i, state, identifier =$tok_begin, $i_begin, $id_scan_state_begin, $identifier_begin\n";
            print {*STDOUT}
"SCANID: returned with tok, i, state, identifier =$tok, $i, $id_scan_state, $identifier\n";
        };

        return (

            $i,
            $tok,
            $type,
            $id_scan_state,
            $identifier,
            $split_pretoken_flag,
        );
    } ## end sub scan_complex_identifier
} ## end closure for sub scan_complex_identifier

{    ## closure for sub do_scan_sub

    # saved package and subnames in case prototype is on separate line
    my ( $package_saved, $subname_saved );

    # initialize subname each time a new 'sub' keyword is encountered
    sub initialize_subname {
        $package_saved = EMPTY_STRING;
        $subname_saved = EMPTY_STRING;
        return;
    }

    use constant {
        SUB_CALL       => 1,
        PAREN_CALL     => 2,
        PROTOTYPE_CALL => 3,
    };

    sub do_scan_sub {

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

        # Parse a sub name and prototype.

        my $input_line      = $rcall_hash->{input_line};
        my $i               = $rcall_hash->{i};
        my $i_beg           = $rcall_hash->{i_beg};
        my $tok             = $rcall_hash->{tok};
        my $type            = $rcall_hash->{type};
        my $rtokens         = $rcall_hash->{rtokens};
        my $rtoken_map      = $rcall_hash->{rtoken_map};
        my $id_scan_state   = $rcall_hash->{id_scan_state};
        my $max_token_index = $rcall_hash->{max_token_index};

        my $id_prefix = $rcall_hash->{is_lexical_method} ? '$' : EMPTY_STRING;

        # At present there are three basic CALL TYPES which are
        # distinguished by the starting value of '$tok':
        # 1. $tok='sub', id_scan_state='sub'
        #    it is called with $i_beg equal to the index of the first nonblank
        #    token following a 'sub' token.
        # 2. $tok='(', id_scan_state='sub',
        #    it is called with $i_beg equal to the index of a '(' which may
        #    start a prototype.
        # 3. $tok='prototype', id_scan_state='prototype'
        #    it is called with $i_beg equal to the index of a '(' which is
        #    preceded by ': prototype' and has $id_scan_state eq 'prototype'

        # Examples:

        # A single type 1 call will get both the sub and prototype
        #   sub foo1 ( $$ ) { }
        #   ^

        # The subname will be obtained with a 'sub' call
        # The prototype on line 2 will be obtained with a '(' call
        #   sub foo1
        #   ^                    <---call type 1
        #     ( $$ ) { }
        #     ^                  <---call type 2

        # The subname will be obtained with a 'sub' call
        # The prototype will be obtained with a 'prototype' call
        #   sub foo1 ( $x, $y ) : prototype ( $$ ) { }
        #   ^ <---type 1                    ^ <---type 3

        # TODO: add future error checks to be sure we have a valid
        # sub name.  For example, 'sub &doit' is wrong.  Also, be sure
        # a name is given if and only if a non-anonymous sub is
        # appropriate.
        # USES GLOBAL VARS: $current_package, $last_nonblank_token,
        # $rsaw_function_definition,
        # $statement_type

        my $i_entry = $i;

        # Determine the CALL TYPE
        # 1=sub
        # 2=(
        # 3=prototype
        my $call_type =
            $tok eq 'prototype' ? PROTOTYPE_CALL
          : $tok eq '('         ? PAREN_CALL
          :                       SUB_CALL;

        $id_scan_state = EMPTY_STRING;  # normally we get everything in one call
        my $subname = $subname_saved;
        my $package = $package_saved;
        my $proto   = undef;
        my $attrs   = undef;
        my $match;

        my $pos_beg = $rtoken_map->[$i_beg];
        pos($input_line) = $pos_beg;

        # Look for the sub NAME if this is a SUB call
        if (
               $call_type == SUB_CALL
            && $input_line =~ m{\G\s*
                ((?:\w*(?:'|::))*)  # package - something that ends in :: or '
                (\w+)               # NAME    - required
                }gcx
          )
        {
            $match   = 1;
            $subname = $2;
            my $is_lexical_sub = $last_nonblank_type eq 'k'
              && $is_my_our_state{$last_nonblank_token};
            if ( $is_lexical_sub && $1 ) {
                $self->warning(
"'$last_nonblank_token' sub $subname cannot be in package '$1'\n"
                );
                $is_lexical_sub = 0;
            }

            if ($is_lexical_sub) {

                # Lexical subs use the containing block sequence number as a
                # package name.
                my $seqno =
                  $rcurrent_sequence_number->[BRACE]
                  ->[ $rcurrent_depth->[BRACE] ];
                $seqno   = SEQ_ROOT if ( !defined($seqno) );
                $package = $seqno;

                # The value will eventually be the sequence number of the
                # opening curly brace of the definition (if any). We use -1
                # until we find it.
                $ris_lexical_sub->{$subname}->{$package} = -1;

                # Set a special signal to tell sub do_LEFT_CURLY_BRACKET to
                # update this value if the next opening sub block brace is for
                # this sub.  The reason we need this value is to avoid applying
                # this new sub in its own definition block.  Note that '911' is
                # not a possible sub name. Search for '911' for related code.
                $ris_lexical_sub->{911} = [ $subname, $package ];

                # Complain if lexical sub name hides a quote operator
                if ( $is_q_qq_qw_qx_qr_s_y_tr_m{$subname} ) {
                    $self->complain(
                        "'my' sub '$subname' matches a builtin quote operator\n"
                    );
                    ## OLD CODING, before improved handling of lexical subs:
                    ## This may end badly, it is safest to avoid formatting.
                    ## For an example, see perl527/lexsub.t (issue c203)
                    ## $self->[_do_not_format_] = 1;
                }
            }
            else {
                $package = ( defined($1) && $1 ) ? $1 : $current_package;
                $package =~ s/\'/::/g;
                if ( $package =~ /^\:/ ) { $package = 'main' . $package }
                $package =~ s/::$//;
            }

            my $pos  = pos($input_line);
            my $numc = $pos - $pos_beg;
            $tok = 'sub ' . $id_prefix . substr( $input_line, $pos_beg, $numc );
            $type = 'S';    ## Fix for c250, was 'i';

            # remember the sub name in case another call is needed to
            # get the prototype
            $package_saved = $package;
            $subname_saved = $subname;
        }

        # Now look for PROTO ATTRS for all call types
        # Look for prototype/attributes which are usually on the same
        # line as the sub name but which might be on a separate line.
        # For example, we might have an anonymous sub with attributes,
        # or a prototype on a separate line from its sub name

        # NOTE: We only want to parse PROTOTYPES here. If we see anything that
        # does not look like a prototype, we assume it is a SIGNATURE and we
        # will stop and let the standard tokenizer handle it.  In
        # particular, we stop if we see any nested parens, braces, or commas.
        # Also note, a valid prototype cannot contain any alphabetic character
        #  -- see https://perldoc.perl.org/perlsub
        # But it appears that an underscore is valid in a prototype, so the
        # regex below uses [A-Za-z] rather than \w
        # This is the old regex which has been replaced:
        # $input_line =~ m/\G(\s*\([^\)\(\}\{\,#]*\))?  # PROTO
        # Added '=' for issue c362
        my $saw_opening_paren = $input_line =~ /\G\s*\(/;
        if (
            $input_line =~ m{\G(\s*\([^\)\(\}\{\,#A-Za-z=]*\))?  # PROTO
                        (\s*:)?                              # ATTRS leading ':'
                        }gcx
            && ( $1 || $2 )
          )
        {
            $proto = $1;
            $attrs = $2;

            # Append the prototype to the starting token if it is 'sub' or
            # 'prototype'.  This is not necessary but for compatibility with
            # previous versions when the -csc flag is used:
            if ( $proto && ( $match || $call_type == PROTOTYPE_CALL ) ) {
                $tok .= $proto;
            }

            # If we just entered the sub at an opening paren on this call, not
            # a following :prototype, label it with the previous token.  This is
            # necessary to propagate the sub name to its opening block.
            elsif ( $call_type == PAREN_CALL ) {
                $tok = $last_nonblank_token;
            }
            else {
                ##
            }

            $match ||= 1;

            # Patch part #1 to fixes cases b994 and b1053:
            # Mark an anonymous sub keyword without prototype as type 'k', i.e.
            #    'sub : lvalue { ...'
            $type = 'S';    ## C250, was 'i';
            if ( $tok eq 'sub' && !$proto ) { $type = 'k' }
        }

        if ($match) {

            # ATTRS: if there are attributes, back up and let the ':' be
            # found later by the scanner.
            my $pos = pos($input_line);
            if ($attrs) {
                $pos -= length($attrs);
            }

            my $next_nonblank_token = $tok;

            # catch case of line with leading ATTR ':' after anonymous sub
            if ( $pos == $pos_beg && $tok eq ':' ) {
                $type = 'A';
                $self->[_in_attribute_list_] = 1;
            }

            # Otherwise, if we found a match we must convert back from
            # string position to the pre_token index for continued parsing.
            else {

                # I don't think an error flag can occur here ..but ?
                my $error;
                ( $i, $error ) = inverse_pretoken_map( $i, $pos, $rtoken_map,
                    $max_token_index );
                if ($error) { $self->warning("Possibly invalid sub\n") }

                # Patch part #2 to fixes cases b994 and b1053:
                # Do not let spaces be part of the token of an anonymous sub
                # keyword which we marked as type 'k' above...i.e. for
                # something like:
                #    'sub : lvalue { ...'
                # Back up and let it be parsed as a blank
                if (   $type eq 'k'
                    && $attrs
                    && $i > $i_entry
                    && substr( $rtokens->[$i], 0, 1 ) =~ m/\s/ )
                {
                    $i--;
                }

                # check for multiple definitions of a sub
                ( $next_nonblank_token, my $i_next_uu ) =
                  find_next_nonblank_token_on_this_line( $i, $rtokens,
                    $max_token_index );
            }

            if ( $next_nonblank_token =~ /^(\s*|#)$/ )
            {    # skip blank or side comment
                my ( $rpre_tokens, $rpre_types_uu ) =
                  $self->peek_ahead_for_n_nonblank_pre_tokens(1);
                if ( defined($rpre_tokens) && @{$rpre_tokens} ) {
                    $next_nonblank_token = $rpre_tokens->[0];
                }
                else {
                    $next_nonblank_token = '}';
                }
            }

            # See what's next...
            if ( $next_nonblank_token eq '{' ) {
                if ($subname) {

                    # Check for multiple definitions of a sub, but
                    # it is ok to have multiple sub BEGIN, etc,
                    # so we do not complain if name is all caps
                    if (   $rsaw_function_definition->{$subname}->{$package}
                        && $subname !~ /^[A-Z]+$/ )
                    {
                        my $lno =
                          $rsaw_function_definition->{$subname}->{$package};
                        if ( $package =~ /^\d/ ) {
                            $self->warning(
"already saw definition of lexical 'sub $subname' at line $lno\n"
                            );

                        }
                        else {
                            if ( !DEVEL_MODE ) {
                                $self->warning(
"already saw definition of 'sub $subname' in package '$package' at line $lno\n"
                                );
                            }
                        }
                    }
                    $rsaw_function_definition->{$subname}->{$package} =
                      $self->[_last_line_number_];
                }
            }
            elsif ( $next_nonblank_token eq ';' ) {
            }
            elsif ( $next_nonblank_token eq '}' ) {
            }

            # ATTRS - if an attribute list follows, remember the name
            # of the sub so the next opening brace can be labeled.
            # Setting 'statement_type' causes any ':'s to introduce
            # attributes.
            elsif ( $next_nonblank_token eq ':' ) {
                if ( $call_type == SUB_CALL ) {
                    $statement_type =
                      substr( $tok, 0, 3 ) eq 'sub' ? $tok : 'sub';
                }
            }

            # if we stopped before an open paren ...
            elsif ( $next_nonblank_token eq '(' ) {

                # If we DID NOT see this paren above then it must be on the
                # next line so we will set a flag to come back here and see if
                # it is a PROTOTYPE

                # Otherwise, we assume it is a SIGNATURE rather than a
                # PROTOTYPE and let the normal tokenizer handle it as a list
                if ( !$saw_opening_paren ) {
                    $id_scan_state = 'sub';    # we must come back to get proto
                }
                if ( $call_type == SUB_CALL ) {
                    $statement_type =
                      substr( $tok, 0, 3 ) eq 'sub' ? $tok : 'sub';
                }
            }

            # something else..
            elsif ($next_nonblank_token) {

                if ( $rcall_hash->{tok} eq 'method' && $call_type == SUB_CALL )
                {
                    # For a method call, silently ignore this error (rt145706)
                    # to avoid needless warnings. Example which can produce it:
                    #     test(method Pack (), "method");

                    # TODO: scan for use feature 'class' and:
                    # - if we saw 'use feature 'class' then issue the warning.
                    # - if we did not see use feature 'class' then issue the
                    #   warning and suggest turning off --use-feature=class
                }
                else {
                    $subname = EMPTY_STRING unless ( defined($subname) );
                    $self->warning(
"expecting ':' or ';' or '{' after definition or declaration of sub '$subname' but saw '$next_nonblank_token'\n"
                    );
                }
            }
            else {
                ## EOF technically ok
            }

            check_prototype( $proto, $package, $subname );
        }

        # no match to either sub name or prototype, but line not blank
        else {
            ##
        }
        return ( $i, $tok, $type, $id_scan_state );
    } ## end sub do_scan_sub
}

#########################################################################
# Tokenizer utility routines which may use CONSTANTS but no other GLOBALS
#########################################################################

sub find_next_nonblank_token {
    my ( $self, $i, $rtokens, $max_token_index ) = @_;

    # Returns the next nonblank token after the token at index $i
    # To skip past a side comment, and any subsequent block comments
    # and blank lines, call with i=$max_token_index

    # Skip any ending blank (fix c258). It would be cleaner if caller passed
    # $rtoken_map, so we could check for type 'b', and avoid a regex test, but
    # benchmarking shows that this test does not take significant time.  So
    # that would be a nice update but not essential.  Also note that ending
    # blanks will not occur for text previously processed by perltidy.
    if (   $i == $max_token_index - 1
        && $rtokens->[$max_token_index] =~ /^\s+$/ )
    {
        $i++;
    }

    if ( $i >= $max_token_index ) {
        if ( !peeked_ahead() ) {
            peeked_ahead(1);
            $self->peek_ahead_for_nonblank_token( $rtokens, $max_token_index );
        }
    }

    my $next_nonblank_token = $rtokens->[ ++$i ];

    # Any more tokens?
    return ( SPACE, $i )
      if ( !defined($next_nonblank_token) || !length($next_nonblank_token) );

    # Skip over whitespace
    my $ord = ord( substr( $next_nonblank_token, 0, 1 ) );
    if (

        ( $ord <= ORD_PRINTABLE_MIN || $ord >= ORD_PRINTABLE_MAX )

        # Quick test for ascii space or tab
        && (
            ( $ord == ORD_SPACE || $ord == ORD_TAB )

            # Slow test to for something else identified as whitespace
            || $next_nonblank_token =~ /^\s+$/
        )
      )
    {
        $next_nonblank_token = $rtokens->[ ++$i ];
        return ( SPACE, $i ) unless ( defined($next_nonblank_token) );
    }

    # We should be at a nonblank now
    return ( $next_nonblank_token, $i );

} ## end sub find_next_nonblank_token

sub find_next_noncomment_token {
    my ( $self, $i, $rtokens, $max_token_index ) = @_;

    # Given the current character position, look ahead past any comments
    # and blank lines and return the next token, including digraphs and
    # trigraphs.

    my ( $next_nonblank_token, $i_next ) =
      $self->find_next_nonblank_token( $i, $rtokens, $max_token_index );

    # skip past any side comment
    if ( $next_nonblank_token eq '#' ) {
        ( $next_nonblank_token, $i_next ) =
          $self->find_next_nonblank_token( $i_next, $rtokens,
            $max_token_index );
    }

    # check for a digraph
    if (   $next_nonblank_token
        && $next_nonblank_token ne SPACE
        && defined( $rtokens->[ $i_next + 1 ] ) )
    {
        my $test2 = $next_nonblank_token . $rtokens->[ $i_next + 1 ];
        if ( $is_digraph{$test2} ) {
            $next_nonblank_token = $test2;
            $i_next              = $i_next + 1;

            # check for a trigraph
            if ( defined( $rtokens->[ $i_next + 1 ] ) ) {
                my $test3 = $next_nonblank_token . $rtokens->[ $i_next + 1 ];
                if ( $is_trigraph{$test3} ) {
                    $next_nonblank_token = $test3;
                    $i_next              = $i_next + 1;
                }
            }
        }
    }

    return ( $next_nonblank_token, $i_next );
} ## end sub find_next_noncomment_token

sub is_possible_numerator {

    my ( $self, $i, $rtokens, $max_token_index ) = @_;

    # Look at the next non-comment character and decide if it could be a
    # numerator. Returns the following code:
    #   -1 - division not possible
    #    0 - can't tell if division possible
    #    1 - division possible
    #    2 - division probable: number follows
    #    3 - division very probable: number and one of ; ] } follow
    #    4 - is division, not pattern: number and ) follow

    my $divide_possible_code = 0;

    my $next_token = $rtokens->[ $i + 1 ];
    if ( $next_token eq '=' ) { $i++; }    # handle /=
    my ( $next_nonblank_token, $i_next ) =
      $self->find_next_nonblank_token( $i, $rtokens, $max_token_index );

    if ( $next_nonblank_token eq '#' ) {
        ( $next_nonblank_token, $i_next ) =
          $self->find_next_nonblank_token( $max_token_index, $rtokens,
            $max_token_index );
    }

    if ( $next_nonblank_token =~ / [ \( \$ \w \. \@ ] /x ) {
        $divide_possible_code = 1;

        # look ahead one more token for some common patterns, such as
        #   pi/2)   pi/2;   pi/2}
        if ( $next_nonblank_token =~ /^\d/ ) {
            my ( $next_next_nonblank_token, $i_next_next_uu ) =
              $self->find_next_nonblank_token( $i_next, $rtokens,
                $max_token_index );
            if ( $next_next_nonblank_token eq ')' ) {
                $divide_possible_code = 4;
            }
            elsif ($next_next_nonblank_token eq ';'
                || $next_next_nonblank_token eq ']'
                || $next_next_nonblank_token eq '}' )
            {
                $divide_possible_code = 3;
            }
            else {
                $divide_possible_code = 2;
            }
        }
    }
    elsif ( $next_nonblank_token =~ /^\s*$/ ) {
        $divide_possible_code = 0;
    }
    else {
        $divide_possible_code = -1;
    }

    return $divide_possible_code;
} ## end sub is_possible_numerator

{    ## closure for sub pattern_expected
    my %pattern_test;

    BEGIN {

        # List of tokens which may follow a pattern.  Note that we will not
        # have formed digraphs at this point, so we will see '&' instead of
        # '&&' and '|' instead of '||'

        # /(\)|\}|\;|\&\&|\|\||and|or|while|if|unless)/
        my @q = qw( & && | || ? : + - * and or while if unless );
        push @q, ')', '}', ']', '>', COMMA, ';';
        $pattern_test{$_} = 1 for @q;
    } ## end BEGIN

    sub pattern_expected {

        my ( $self, $i, $rtokens, $max_token_index ) = @_;

        # This a filter for a possible pattern.
        # It looks at the token after a possible pattern and tries to
        # determine if that token could end a pattern.
        # returns -
        #   1 - yes
        #   0 - can't tell
        #  -1 - no
        my $is_pattern = 0;

        my $next_token = $rtokens->[ $i + 1 ];

        # skip a possible quote modifier
        my $possible_modifiers = $quote_modifiers{'m'};
        if ( $next_token =~ /^$possible_modifiers/ ) {
            $i++;
        }

        my ( $next_nonblank_token, $i_next_uu ) =
          $self->find_next_nonblank_token( $i, $rtokens, $max_token_index );

        if ( $pattern_test{$next_nonblank_token} ) {
            $is_pattern = 1;
        }
        else {

            # Added '#' to fix issue c044
            if (   $next_nonblank_token =~ /^\s*$/
                || $next_nonblank_token eq '#' )
            {
                $is_pattern = 0;
            }
            else {
                $is_pattern = -1;
            }
        }
        return $is_pattern;
    } ## end sub pattern_expected
}

sub find_next_nonblank_token_on_this_line {
    my ( $i, $rtokens, $max_token_index ) = @_;
    my $next_nonblank_token;

    if ( $i < $max_token_index ) {
        $next_nonblank_token = $rtokens->[ ++$i ];

        if ( $next_nonblank_token =~ /^\s*$/ ) {

            if ( $i < $max_token_index ) {
                $next_nonblank_token = $rtokens->[ ++$i ];
            }
        }
    }
    else {
        $next_nonblank_token = EMPTY_STRING;
    }
    return ( $next_nonblank_token, $i );
} ## end sub find_next_nonblank_token_on_this_line

sub find_angle_operator_termination {

    my ( $self, $input_line, $i_beg, $rtoken_map, $expecting, $max_token_index )
      = @_;

    # We are looking at a '<' and want to know if it is an angle operator.
    # Return:
    #   $i = pretoken index of ending '>' if found, current $i otherwise
    #   $type = 'Q' if found, '>' otherwise

    my $i    = $i_beg;
    my $type = '<';
    pos($input_line) = 1 + $rtoken_map->[$i];

    # The token sequence '><' implies a markup language
    if ( $last_nonblank_token eq '>' ) {
        $self->[_html_tag_count_]++;
    }

    my $filter;

    my $expecting_TERM = $expecting == TERM;

    # we just have to find the next '>' if a term is expected
    if ($expecting_TERM) { $filter = '[\>]' }

    # we have to guess if we don't know what is expected
    elsif ( $expecting == UNKNOWN ) { $filter = '[\>\;\=\#\|\<]' }

    # shouldn't happen - we shouldn't be here if operator is expected
    else {
        if (DEVEL_MODE) {
            Fault(<<EOM);
Bad call to find_angle_operator_termination
EOM
        }
        return ( $i, $type );
    }

    # To illustrate what we might be looking at, in case we are
    # guessing, here are some examples of valid angle operators
    # (or file globs):
    #  <tmp_imp/*>
    #  <FH>
    #  <$fh>
    #  <*.c *.h>
    #  <_>
    #  <jskdfjskdfj* op/* jskdjfjkosvk*> ( glob.t)
    #  <${PREFIX}*img*.$IMAGE_TYPE>
    #  <img*.$IMAGE_TYPE>
    #  <Timg*.$IMAGE_TYPE>
    #  <$LATEX2HTMLVERSIONS${dd}html[1-9].[0-9].pl>
    #
    # Here are some examples of lines which do not have angle operators:
    #  return unless $self->[2]++ < $#{$self->[1]};
    #  < 2  || @$t >
    #
    # the following line from dlister.pl caused trouble:
    #  print'~'x79,"\n",$D<1024?"0.$D":$D>>10,"K, $C files\n\n\n";
    #
    # If the '<' starts an angle operator, it must end on this line and
    # it must not have certain characters like ';' and '=' in it.  I use
    # this to limit the testing.  This filter should be improved if
    # possible.

    if ( $input_line =~ /($filter)/g ) {

        if ( $1 eq '>' ) {

            # We MAY have found an angle operator termination if we get
            # here, but we need to do more to be sure we haven't been
            # fooled.
            my $pos = pos($input_line);

            my $pos_beg = $rtoken_map->[$i];
            my $str     = substr( $input_line, $pos_beg, ( $pos - $pos_beg ) );

            # Test for '<' after possible filehandle, issue c103
            # print $fh <>;          # syntax error
            # print $fh <DATA>;      # ok
            # print $fh < DATA>;     # syntax error at '>'
            # print STDERR < DATA>;  # ok, prints word 'DATA'
            # print BLABLA <DATA>;   # ok; does nothing unless BLABLA is defined
            if ( $last_nonblank_type eq 'Z' ) {

                # $str includes brackets; something like '<DATA>'
                if (   substr( $last_nonblank_token, 0, 1 ) !~ /[A-Za-z_]/
                    && substr( $str, 1, 1 ) !~ /[A-Za-z_]/ )
                {
                    return ( $i, $type );
                }
            }

            # Reject if the closing '>' follows a '-' as in:
            # if ( VERSION < 5.009 && $op-> name eq 'assign' ) { }
            if ( $expecting eq UNKNOWN ) {
                my $check = substr( $input_line, $pos - 2, 1 );
                if ( $check eq '-' ) {
                    return ( $i, $type );
                }
            }

            ######################################debug#####
            #$self->write_diagnostics( "ANGLE? :$str\n");
            #print "ANGLE: found $1 at pos=$pos str=$str check=$check\n";
            ######################################debug#####
            $type = 'Q';
            my $error;
            ( $i, $error ) =
              inverse_pretoken_map( $i, $pos, $rtoken_map, $max_token_index );

            # It may be possible that a quote ends midway in a pretoken.
            # If this happens, it may be necessary to split the pretoken.
            if ($error) {
                if (DEVEL_MODE) {
                    Fault(<<EOM);
unexpected error condition returned by inverse_pretoken_map
EOM
                }
                $self->warning(
                    "Possible tokenization error..please check this line\n");
            }

            # Check for accidental formatting of a markup language doc...
            # Formatting will be skipped if we set _html_tag_count_ and
            # also set a warning of any kind.
            my $is_html_tag;
            my $is_first_string =
              $i_beg == 0 && $self->[_last_line_number_] == 1;

            # html comment '<!...' of any type
            if ( $str =~ /^<\s*!/ ) {
                $is_html_tag = 1;
                if ($is_first_string) {
                    $self->warning(
"looks like a markup language, continuing error checks\n"
                    );
                }
            }

            # html end tag, something like </h1>
            elsif ( $str =~ /^<\s*\/\w+\s*>$/ ) {
                $is_html_tag = 1;
            }

            # xml prolog?
            elsif ( $str =~ /^<\?xml\s.*\?>$/i && $is_first_string ) {
                $is_html_tag = 1;
                $self->warning(
                    "looks like a markup language, continuing error checks\n");
            }
            else {
                ## doesn't look like a markup tag
            }

            if ($is_html_tag) {
                $self->[_html_tag_count_]++;
            }

            # count blanks on inside of brackets
            my $blank_count = 0;
            $blank_count++ if ( $str =~ /<\s+/ );
            $blank_count++ if ( $str =~ /\s+>/ );

            # Now let's see where we stand....
            # OK if math op not possible
            if ($expecting_TERM) {
            }

            elsif ($is_html_tag) {
            }

            # OK if there are no more than 2 non-blank pre-tokens inside
            # (not possible to write 2 token math between < and >)
            # This catches most common cases
            elsif ( $i <= $i_beg + 3 + $blank_count ) {

                # No longer any need to document this common case
                ## $self->write_diagnostics("ANGLE(1 or 2 tokens): $str\n");
            }

            # OK if there is some kind of identifier inside
            #   print $fh <tvg::INPUT>;
            elsif ( $str =~ /^<\s*\$?(\w|::|\s)+\s*>$/ ) {
                $self->write_diagnostics("ANGLE (contains identifier): $str\n");
            }

            # Not sure..
            else {

                # Let's try a Brace Test: any braces inside must balance
                my $br = $str =~ tr/\{/{/ - $str =~ tr/\}/}/;
                my $sb = $str =~ tr/\[/[/ - $str =~ tr/\]/]/;
                my $pr = $str =~ tr/\(/(/ - $str =~ tr/\)/)/;

                # if braces do not balance - not angle operator
                if ( $br || $sb || $pr ) {
                    $i    = $i_beg;
                    $type = '<';
                    $self->write_diagnostics(
                        "NOT ANGLE (BRACE={$br ($pr [$sb ):$str\n");
                }

                # we should keep doing more checks here...to be continued
                # Tentatively accepting this as a valid angle operator.
                # There are lots more things that can be checked.
                else {
                    $self->write_diagnostics(
                        "ANGLE-Guessing yes: $str expecting=$expecting\n");
                    $self->write_logfile_entry(
                        "Guessing angle operator here: $str\n");
                }
            }
        }

        # didn't find ending >
        else {
            if ($expecting_TERM) {
                $self->warning("No ending > for angle operator\n");
            }
        }
    }
    return ( $i, $type );
} ## end sub find_angle_operator_termination

sub scan_number_do {

    my ( $self, $input_line, $i, $rtoken_map, $input_type, $max_token_index ) =
      @_;

    #  Scan a number in any of the formats that Perl accepts
    #  Underbars (_) are allowed in decimal numbers.
    #  Given:
    #      $input_line  - the string to scan
    #      $i           - pre_token index to start scanning
    #    $rtoken_map    - reference to the pre_token map giving starting
    #                    character position in $input_line of token $i
    #  Return:
    #    $i            - last pre_token index of the number just scanned
    #    $type         - the token type ('v' or 'n')
    #    number        - the number (characters); or undef if not a number

    my $pos_beg = $rtoken_map->[$i];
    my $pos;
    ##my $i_begin = $i;
    my $number = undef;
    my $type   = $input_type;

    my $first_char = substr( $input_line, $pos_beg, 1 );

    # Look for bad starting characters; Shouldn't happen..
    if ( $first_char !~ /[\d\.\+\-Ee]/ ) {
        if (DEVEL_MODE) {
            Fault(<<EOM);
Program bug - scan_number given bad first character = '$first_char'
EOM
        }
        return ( $i, $type, $number );
    }

    # handle v-string without leading 'v' character ('Two Dot' rule)
    # (vstring.t)
    # Here is the format prior to including underscores:
    ## if ( $input_line =~ /\G((\d+)?\.\d+(\.\d+)+)/g ) {
    pos($input_line) = $pos_beg;
    if ( $input_line =~ /\G((\d[_\d]*)?\.[\d_]+(\.[\d_]+)+)/g ) {
        $pos = pos($input_line);
        my $numc = $pos - $pos_beg;
        $number = substr( $input_line, $pos_beg, $numc );
        $type   = 'v';
    }

    # handle octal, hex, binary
    if ( !defined($number) ) {
        pos($input_line) = $pos_beg;

        # Perl 5.22 added floating point literals, like '0x0.b17217f7d1cf78p0'
        # For reference, the format prior to hex floating point is:
        #   /\G[+-]?0(([xX][0-9a-fA-F_]+)|([0-7_]+)|([bB][01_]+))/g )
        #             (hex)               (octal)   (binary)
        if (
            $input_line =~ m{

                        \G[+-]?0(                   # leading [signed] 0

                      # a hex float, i.e. '0x0.b17217f7d1cf78p0'
                      ([xX][0-9a-fA-F_]*            # X and optional leading digits
                      (\.([0-9a-fA-F][0-9a-fA-F_]*)?)?   # optional decimal and fraction
                      [Pp][+-]?[0-9a-fA-F]          # REQUIRED exponent with digit
                      [0-9a-fA-F_]*)                # optional Additional exponent digits

                      # or hex integer
                      |([xX][0-9a-fA-F_]+)

                      # or octal fraction
                      |([oO]?[0-7_]+          # string of octal digits
                      (\.([0-7][0-7_]*)?)?    # optional decimal and fraction
                      [Pp][+-]?[0-7]          # REQUIRED exponent, no underscore
                      [0-7_]*)                # Additional exponent digits with underscores

                      # or octal integer
                      |([oO]?[0-7_]+)         # string of octal digits

                      # or a binary float
                      |([bB][01_]*            # 'b' with string of binary digits
                      (\.([01][01_]*)?)?      # optional decimal and fraction
                      [Pp][+-]?[01]           # Required exponent indicator, no underscore
                      [01_]*)                 # additional exponent bits

                      # or binary integer
                      |([bB][01_]+)           # 'b' with string of binary digits

                      )}gx
          )
        {
            $pos = pos($input_line);
            my $numc = $pos - $pos_beg;
            $number = substr( $input_line, $pos_beg, $numc );
            $type   = 'n';
        }
    }

    # handle decimal
    if ( !defined($number) ) {
        pos($input_line) = $pos_beg;

        if ( $input_line =~ /\G([+-]?[\d_]*(\.[\d_]*)?([Ee][+-]?(\d+))?)/g ) {
            $pos = pos($input_line);

            # watch out for things like 0..40 which would give 0. by this;
            if (   ( substr( $input_line, $pos - 1, 1 ) eq '.' )
                && ( substr( $input_line, $pos, 1 ) eq '.' ) )
            {
                $pos--;
            }
            my $numc = $pos - $pos_beg;
            $number = substr( $input_line, $pos_beg, $numc );
            $type   = 'n';
        }
    }

    # filter out non-numbers like e + - . e2  .e3 +e6
    # the rule: at least one digit, and any 'e' must be preceded by a digit
    if (
        $number !~ /\d/    # no digits
        || (   $number =~ /^(.*)[eE]/
            && $1 !~ /\d/ )    # or no digits before the 'e'
      )
    {
        $number = undef;
        $type   = $input_type;
        return ( $i, $type, $number );
    }

    # Found a number; now we must convert back from character position
    # to pre_token index. An error here implies user syntax error.
    # An example would be an invalid octal number like '009'.
    my $error;
    ( $i, $error ) =
      inverse_pretoken_map( $i, $pos, $rtoken_map, $max_token_index );
    if ($error) { $self->warning("Possibly invalid number\n") }

    return ( $i, $type, $number );
} ## end sub scan_number_do

sub inverse_pretoken_map {

    # Starting with the current pre_token index $i, scan forward until
    # finding the index of the next pre_token whose position is $pos.
    my ( $i, $pos, $rtoken_map, $max_token_index ) = @_;
    my $error = 0;

    while ( ++$i <= $max_token_index ) {

        if ( $pos <= $rtoken_map->[$i] ) {

            # Let the calling routine handle errors in which we do not
            # land on a pre-token boundary.  It can happen by running
            # perltidy on some non-perl scripts, for example.
            if ( $pos < $rtoken_map->[$i] ) { $error = 1 }
            $i--;
            last;
        }
    } ## end while ( ++$i <= $max_token_index)
    return ( $i, $error );
} ## end sub inverse_pretoken_map

sub find_here_doc {

    my (

        $self,

        $expecting,
        $i,
        $rtokens,
        $rtoken_type,
        $rtoken_map_uu,
        $max_token_index,

    ) = @_;

    # Find the target of a here document, if any
    # Given:
    #   $i - token index of the second < of <<
    #   ($i must be less than the last token index if this is called)
    # Return:
    #   $found_target = 0 didn't find target; =1 found target
    #   HERE_TARGET - the target string (may be empty string)
    #   $i - unchanged if not here doc,
    #    or index of the last token of the here target
    #   $saw_error - flag noting unbalanced quote on here target
    my $ibeg                 = $i;
    my $found_target         = 0;
    my $here_doc_target      = EMPTY_STRING;
    my $here_quote_character = EMPTY_STRING;
    my $saw_error            = 0;
    my ( $next_nonblank_token, $i_next_nonblank, $next_token );
    $next_token = $rtokens->[ $i + 1 ];

    # perl allows a backslash before the target string (heredoc.t)
    my $backslash = 0;
    if ( $next_token eq BACKSLASH ) {
        $backslash  = 1;
        $next_token = $rtokens->[ $i + 2 ];
    }

    ( $next_nonblank_token, $i_next_nonblank ) =
      find_next_nonblank_token_on_this_line( $i, $rtokens, $max_token_index );

    if ( $next_nonblank_token =~ /[\'\"\`]/ ) {

        my $in_quote    = 1;
        my $quote_depth = 0;
        my $quote_pos   = 0;
        my $quoted_string;

        (

            $i,
            $in_quote,
            $here_quote_character,
            $quote_pos,
            $quote_depth,
            $quoted_string,
          )
          = $self->follow_quoted_string(

            $i_next_nonblank,
            $in_quote,
            $rtokens,
            $rtoken_type,
            $here_quote_character,
            $quote_pos,
            $quote_depth,
            $max_token_index,
          );

        if ($in_quote) {    # didn't find end of quote, so no target found
            $i = $ibeg;
            if ( $expecting == TERM ) {
                $self->warning(
"Did not find here-doc string terminator ($here_quote_character) before end of line \n"
                );
                $saw_error = 1;
            }
        }
        else {              # found ending quote
            $found_target = 1;

            my $tokj;
            foreach my $j ( $i_next_nonblank + 1 .. $i - 1 ) {
                $tokj = $rtokens->[$j];

                # we have to remove any backslash before the quote character
                # so that the here-doc-target exactly matches this string
                next
                  if ( $tokj eq BACKSLASH
                    && $j < $i - 1
                    && $rtokens->[ $j + 1 ] eq $here_quote_character );
                $here_doc_target .= $tokj;
            }
        }
    }

    elsif ( ( $next_token =~ /^\s*$/ ) and ( $expecting == TERM ) ) {
        $found_target = 1;
        $self->write_logfile_entry(
            "found blank here-target after <<; suggest using \"\"\n");
        $i = $ibeg;
    }
    elsif ( $next_token =~ /^\w/ ) {    # simple bareword or integer after <<

        my $here_doc_expected;
        if ( $expecting == UNKNOWN ) {
            $here_doc_expected = $self->guess_if_here_doc($next_token);
        }
        else {
            $here_doc_expected = 1;
        }

        if ($here_doc_expected) {
            $found_target    = 1;
            $here_doc_target = $next_token;
            $i               = $ibeg + 1;
        }

    }
    else {

        if ( $expecting == TERM ) {
            $found_target = 1;
            $self->write_logfile_entry("Note: bare here-doc operator <<\n");
        }
        else {
            $i = $ibeg;
        }
    }

    # patch to neglect any prepended backslash
    if ( $found_target && $backslash ) { $i++ }

    return ( $found_target, $here_doc_target, $here_quote_character, $i,
        $saw_error );
} ## end sub find_here_doc

sub do_quote {

    my (

        $self,

        $i,
        $in_quote,
        $quote_character,
        $quote_pos,
        $quote_depth,
        $quoted_string_1,
        $quoted_string_2,
        $rtokens,
        $rtoken_type,
        $rtoken_map_uu,
        $max_token_index,

    ) = @_;

    # Follow (or continue following) quoted string(s)
    # $in_quote = return code:
    #   0 - ok, found end
    #   1 - still must find end of quote whose target is $quote_character
    #   2 - still looking for end of first of two quotes
    #
    # Returns updated strings:
    #  $quoted_string_1 = quoted string seen while in_quote=1
    #  $quoted_string_2 = quoted string seen while in_quote=2

    my $quoted_string;
    if ( $in_quote == 2 ) {    # two quotes/quoted_string_1s to follow
        my $ibeg = $i;
        (

            $i,
            $in_quote,
            $quote_character,
            $quote_pos,
            $quote_depth,
            $quoted_string,
          )
          = $self->follow_quoted_string(

            $ibeg,
            $in_quote,
            $rtokens,
            $rtoken_type,
            $quote_character,
            $quote_pos,
            $quote_depth,
            $max_token_index,
          );
        $quoted_string_2 .= $quoted_string;
        if ( $in_quote == 1 ) {
            if ( $quote_character =~ /[\{\[\<\(]/ ) { $i++; }
            $quote_character = EMPTY_STRING;
        }
        else {
            $quoted_string_2 .= "\n";
        }
    }

    if ( $in_quote == 1 ) {    # one (more) quote to follow
        my $ibeg = $i;
        (

            $i,
            $in_quote,
            $quote_character,
            $quote_pos,
            $quote_depth,
            $quoted_string,
          )
          = $self->follow_quoted_string(

            $ibeg,
            $in_quote,
            $rtokens,
            $rtoken_type,
            $quote_character,
            $quote_pos,
            $quote_depth,
            $max_token_index,
          );
        $quoted_string_1 .= $quoted_string;
        if ( $in_quote == 1 ) {
            $quoted_string_1 .= "\n";
        }
    }
    return (

        $i,
        $in_quote,
        $quote_character,
        $quote_pos,
        $quote_depth,
        $quoted_string_1,
        $quoted_string_2,

    );
} ## end sub do_quote

use constant DEBUG_FIND_INTERPOLATED_HERE_TARGETS => 0;

sub find_interpolated_here_targets {
    my ( $self, $quoted_string, $len_starting_lines ) = @_;

    # Search for here targets in a quoted string
    # Given:
    #   $quoted_string = the complete string of an interpolated quote
    #   $len_starting_lines = number of characters of the first n-1 lines
    #      (=0 if this is a single-line quote)
    # Task:
    #   Find and return a list of all here targets on the last line;
    #   i.e., if here target is index ii, we only return the
    #   target if $rmap->[$ii]>=$len_starting_lines

    #  The items returned are the format needed for @{$rhere_target_list};
    #  [ $here_doc_target, $here_quote_character ]
    #  there can be multiple here targets.

    my $rht;

    # Break the entire quote into pre-tokens, even if multi-line, because we
    # have to determine which parts are in single quotes
    my ( $rtokens, $rmap, $rtoken_type ) = pre_tokenize($quoted_string);
    my $max_ii = @{$rtokens} - 1;

    # Depth of braces controlled by a sigil
    my $code_depth = 0;

    # Loop over pre-tokens
    my $ii = -1;
    while ( ++$ii <= $max_ii ) {
        my $token = $rtokens->[$ii];
        if (DEBUG_FIND_INTERPOLATED_HERE_TARGETS) {
            print "i=$ii tok=$token block=$code_depth\n";
        }

        if ( $token eq BACKSLASH ) {
            if ( !$code_depth ) { $ii++ }
            next;
        }

        # Look for start of interpolation code block, '${', '@{', '$var{', etc
        if ( !$code_depth ) {
            if ( $token eq '$' || $token eq '@' ) {

                $ii++
                  if ( $ii < $max_ii && $rtoken_type->[ $ii + 1 ] eq 'b' );

                while (
                    $ii < $max_ii
                    && (   $rtoken_type->[ $ii + 1 ] eq 'w'
                        || $rtoken_type->[ $ii + 1 ] eq '::' )
                  )
                {
                    $ii++;
                } ## end while ( $ii < $max_ii && ...)

                $ii++
                  if ( $ii < $max_ii && $rtoken_type->[ $ii + 1 ] eq 'b' );

                if ( $ii < $max_ii && $rtokens->[ $ii + 1 ] eq '{' ) {
                    $ii++;
                    $code_depth++;
                }
            }
            next;
        }

        # Continue interpolating while $code_depth > 0..
        if ( $token eq '{' ) {
            $code_depth++;
            next;
        }
        if ( $token eq '}' ) {
            $code_depth--;
            next;
        }

        # Look for '<<'
        if (   $token ne '<'
            || $ii >= $max_ii - 1
            || $rtokens->[ $ii + 1 ] ne '<' )
        {
            next;
        }

        # Remember the location of the first '<' so it can be modified
        my $ii_left_shift = $ii;

        $ii++;

        # or '<<~'
        if ( $rtoken_type->[ $ii + 1 ] eq '~' && $ii < $max_ii - 2 ) {
            $ii++;
        }

        # blanks ok before targets in quotes
        my $saw_blank;
        if ( $rtoken_type->[ $ii + 1 ] eq 'b' && $ii < $max_ii - 2 ) {
            $saw_blank = 1;
            $ii++;
        }

        my $next_type = $rtoken_type->[ $ii + 1 ];

        # Look for unquoted targets like "${ \<<END1 }"
        if ( $next_type eq 'w' ) {
            if ($saw_blank) {
                ## error: blank target is deprecated
            }
            else {
                $ii++;
                if ( $rmap->[$ii] >= $len_starting_lines ) {
                    push @{$rht}, [ $rtokens->[$ii], EMPTY_STRING ];

                    # Modify the string so the target is not found again
                    my $pos_left_shift = $rmap->[$ii_left_shift];
                    substr( $quoted_string, $pos_left_shift,     1, SPACE );
                    substr( $quoted_string, $pos_left_shift + 1, 1, SPACE );
                }
            }
        }

        # Look for quoted targets like  "${ \<< 'END1' }${ \<<\"END2\" }";
        elsif ( $next_type eq "'" || $next_type eq '"' || $next_type eq '`' ) {
            my $quote_char = $next_type;
            $ii++;
            my $here_target = EMPTY_STRING;
            while ( ++$ii <= $max_ii && $rtokens->[$ii] ne $quote_char ) {
                next
                  if ( $quote_char ne "'" && $rtokens->[$ii] eq BACKSLASH );
                $here_target .= $rtokens->[$ii];
            }
            if ( $rmap->[$ii] >= $len_starting_lines ) {
                push @{$rht}, [ $here_target, $quote_char ];
            }
        }
        else {
            ## no here target found
        }
        next;
    } ## end while ( ++$ii <= $max_ii )
    return ( $rht, $quoted_string );
} ## end sub find_interpolated_here_targets

# Some possible non-word quote delimiters, for preliminary checking
my %is_punct_char;

BEGIN {

    my @q = qw# / " ' { } ( ) [ ] < > ; + - * | % ! x ~ = ? : . ^ & #;
    push @q, '#';
    push @q, COMMA;
    $is_punct_char{$_} = 1 for @q;
}

sub follow_quoted_string {

    my (

        $self,

        $i_beg,
        $in_quote,
        $rtokens,
        $rtoken_type,
        $beginning_tok,
        $quote_pos,
        $quote_depth,
        $max_token_index,

    ) = @_;

    # Scan for a specific token, skipping escaped characters.
    # If the quote character is blank, use the first non-blank character.
    # Given:
    #   $rtokens = reference to the array of tokens
    #   $i = the token index of the first character to search
    #   $in_quote = number of quoted strings being followed
    #   $beginning_tok = the starting quote character
    #   $quote_pos = index to check next for alphanumeric delimiter
    # Return:
    #   $i = the token index of the ending quote character
    #   $in_quote = decremented if found end, unchanged if not
    #   $beginning_tok = the starting quote character
    #   $quote_pos = index to check next for alphanumeric delimiter
    #   $quote_depth = nesting depth, since delimiters '{ ( [ <' can be nested.
    #   $quoted_string = the text of the quote (without quotation tokens)
    my ( $tok, $end_tok );
    my $i             = $i_beg - 1;
    my $quoted_string = EMPTY_STRING;

    0 && do {
        print {*STDOUT}
"QUOTE entering with quote_pos = $quote_pos i=$i beginning_tok =$beginning_tok\n";
    };

    # for a non-blank token, get the corresponding end token
    if (
        $is_punct_char{$beginning_tok}
        || ( length($beginning_tok)
            && $beginning_tok !~ /^\s+$/ )
      )
    {
        $end_tok =
            $matching_end_token{$beginning_tok}
          ? $matching_end_token{$beginning_tok}
          : $beginning_tok;
    }

    # for a blank token, find and use the first non-blank one
    else {
        my $allow_quote_comments = ( $i < 0 ) ? 1 : 0; # i<0 means we saw a <cr>

        while ( $i < $max_token_index ) {
            $tok = $rtokens->[ ++$i ];

            if ( $rtoken_type->[$i] ne 'b' ) {

                if ( ( $tok eq '#' ) && ($allow_quote_comments) ) {
                    $i = $max_token_index;
                }
                else {

                    if ( length($tok) > 1 ) {
                        if ( $quote_pos <= 0 ) { $quote_pos = 1 }
                        $beginning_tok = substr( $tok, $quote_pos - 1, 1 );
                    }
                    else {
                        $beginning_tok = $tok;
                        $quote_pos     = 0;
                    }
                    $end_tok =
                        $matching_end_token{$beginning_tok}
                      ? $matching_end_token{$beginning_tok}
                      : $beginning_tok;
                    $quote_depth = 1;
                    last;
                }
            }
            else {
                $allow_quote_comments = 1;
            }
        } ## end while ( $i < $max_token_index)
    }

    # There are two different loops which search for the ending quote
    # character.  In the rare case of an alphanumeric quote delimiter, we
    # have to look through alphanumeric tokens character-by-character, since
    # the pre-tokenization process combines multiple alphanumeric
    # characters, whereas for a non-alphanumeric delimiter, only tokens of
    # length 1 can match.

    #----------------------------------------------------------------
    # Case 1 (rare): loop for case of alphanumeric quote delimiter..
    # "quote_pos" is the position the current word to begin searching
    #----------------------------------------------------------------
    if ( !$is_punct_char{$beginning_tok} && $beginning_tok =~ /\w/ ) {

        # Note this because it is not recommended practice except
        # for obfuscated perl contests
        if ( $in_quote == 1 ) {
            $self->write_logfile_entry(
                "Note: alphanumeric quote delimiter ($beginning_tok) \n");
        }

        # Note: changed < to <= here to fix c109. Relying on extra end blanks.
        while ( $i <= $max_token_index ) {

            if ( $quote_pos == 0 || ( $i < 0 ) ) {
                $tok = $rtokens->[ ++$i ];

                if ( $tok eq BACKSLASH ) {

                    # retain backslash unless it hides the end token
                    $quoted_string .= $tok
                      unless ( $rtokens->[ $i + 1 ] eq $end_tok );
                    $quote_pos++;
                    last if ( $i >= $max_token_index );
                    $tok = $rtokens->[ ++$i ];
                }
            }
            my $old_pos = $quote_pos;

            $quote_pos = 1 + index( $tok, $end_tok, $quote_pos );

            if ( $quote_pos > 0 ) {

                $quoted_string .=
                  substr( $tok, $old_pos, $quote_pos - $old_pos - 1 );

                # NOTE: any quote modifiers will be at the end of '$tok'. If we
                # wanted to check them, this is the place to get them.  But
                # this quote form is rarely used in practice, so it isn't
                # worthwhile.

                $quote_depth--;

                if ( $quote_depth == 0 ) {
                    $in_quote--;
                    last;
                }
            }
            else {
                if ( $old_pos <= length($tok) ) {
                    $quoted_string .= substr( $tok, $old_pos );
                }
            }
        } ## end while ( $i <= $max_token_index)
    }

    #-----------------------------------------------------------------------
    # Case 2 (normal): loop for case of a non-alphanumeric quote delimiter..
    #-----------------------------------------------------------------------
    else {

        while ( $i < $max_token_index ) {
            $tok = $rtokens->[ ++$i ];

            if ( $tok eq $end_tok ) {
                $quote_depth--;

                if ( $quote_depth == 0 ) {
                    $in_quote--;
                    last;
                }
            }
            elsif ( $tok eq $beginning_tok ) {
                $quote_depth++;
            }
            elsif ( $tok eq BACKSLASH ) {

                # retain backslash unless it hides the beginning or end token
                $tok = $rtokens->[ ++$i ];
                $quoted_string .= BACKSLASH
                  if ( $tok ne $end_tok && $tok ne $beginning_tok );
            }
            else {
                ## nothing special
            }
            $quoted_string .= $tok;
        } ## end while ( $i < $max_token_index)
    }
    if ( $i > $max_token_index ) { $i = $max_token_index }
    return (

        $i,
        $in_quote,
        $beginning_tok,
        $quote_pos,
        $quote_depth,
        $quoted_string,

    );
} ## end sub follow_quoted_string

sub indicate_error {
    my ( $self, $msg, $line_number, $input_line, $pos, $caret ) = @_;

    # write input line and line with carat's showing where error was detected
    $self->interrupt_logfile();
    $self->warning($msg);
    $self->write_error_indicator_pair( $line_number, $input_line, $pos,
        $caret );
    $self->resume_logfile();
    return;
} ## end sub indicate_error

sub write_error_indicator_pair {
    my ( $self, $line_number, $input_line, $pos, $caret ) = @_;
    my ( $offset, $numbered_line, $underline ) =
      make_numbered_line( $line_number, $input_line, $pos );
    $underline = write_on_underline( $underline, $pos - $offset, $caret );
    $self->warning( $numbered_line . "\n" );
    $underline =~ s/\s+$//;
    $self->warning( $underline . "\n" );
    return;
} ## end sub write_error_indicator_pair

sub make_numbered_line {

    my ( $lineno, $str, $pos ) = @_;

    #  Given:
    #     $lineno=line number
    #     $str = an input line
    #     $pos = character position of interest
    # Create a string not longer than 80 characters of the form:
    #     $lineno: sub_string
    # such that the sub_string of $str contains the position of interest
    #
    #  Here is an example of what we want, in this case we add trailing
    #  '...' because the line is long.
    #
    # 2: (One of QAML 2.0's authors is a member of the World Wide Web Con ...
    #
    #  Here is another example, this time in which we used leading '...'
    #  because of excessive length:
    #
    # 2: ... er of the World Wide Web Consortium's
    #
    #  input parameters are:
    #   $lineno = line number
    #   $str = the text of the line
    #   $pos = position of interest (the error) : 0 = first character
    #
    #   We return :
    #     - $offset = an offset which corrects the position in case we only
    #       display part of a line, such that $pos-$offset is the effective
    #       position from the start of the displayed line.
    #     - $numbered_line = the numbered line as above,
    #     - $underline = a blank 'underline' which is all spaces with the same
    #       number of characters as the numbered line.

    my $offset = ( $pos < 60 ) ? 0 : $pos - 40;
    my $excess = length($str) - $offset - 68;
    my $numc   = ( $excess > 0 ) ? 68 : undef;

    if ( defined($numc) ) {
        if ( $offset == 0 ) {
            $str = substr( $str, $offset, $numc - 4 ) . " ...";
        }
        else {
            $str = "... " . substr( $str, $offset + 4, $numc - 4 ) . " ...";
        }
    }
    else {

        if ( $offset == 0 ) {
        }
        else {
            $str = "... " . substr( $str, $offset + 4 );
        }
    }

    my $numbered_line = sprintf( "%d: ", $lineno );
    $offset -= length($numbered_line);
    $numbered_line .= $str;
    my $underline = SPACE x length($numbered_line);
    return ( $offset, $numbered_line, $underline );
} ## end sub make_numbered_line

sub write_on_underline {

    my ( $underline, $pos, $pos_chr ) = @_;

    # The "underline" is a string that shows where an error is; it starts
    # out as a string of blanks with the same length as the numbered line of
    # code above it, and we have to add marking to show where an error is.
    # In the example below, we want to write the string '--^' just below
    # the line of bad code:
    #
    # 2: (One of QAML 2.0's authors is a member of the World Wide Web Con ...
    #                 ---^
    # We are given the current underline string, plus a position and a
    # string to write on it.
    #
    # In the above example, there will be 2 calls to do this:
    # First call:  $pos=19, pos_chr=^
    # Second call: $pos=16, pos_chr=---
    #
    # This is a trivial thing to do with substr, but there is some
    # checking to do.

    # check for error..shouldn't happen
    if ( $pos < 0 || $pos > length($underline) ) {
        return $underline;
    }
    my $excess = length($pos_chr) + $pos - length($underline);
    if ( $excess > 0 ) {
        $pos_chr = substr( $pos_chr, 0, length($pos_chr) - $excess );
    }
    substr( $underline, $pos, length($pos_chr), $pos_chr );
    return ($underline);
} ## end sub write_on_underline

sub pre_tokenize {

    my ( $str, ($max_tokens_wanted) ) = @_;

    # Input parameters:
    #  $str = string to be parsed
    #  $max_tokens_wanted > 0  to stop on reaching this many tokens.
    #                     = undef or 0 means get all tokens

    # Break a string, $str, into a sequence of preliminary tokens (pre-tokens).
    # We look for these types of tokens:
    #   words       (type='w'),               example: 'max_tokens_wanted'
    #   digits      (type = 'd'),             example: '0755'
    #   whitespace  (type = 'b'),             example: '   '
    #   single character punct (type = char)  example: '='

    # Later operations will combine one or more of these pre-tokens into final
    # tokens.  We cannot do better than this yet because we might be in a
    # quoted string or pattern.

    # An advantage of doing this pre-tokenization step is that it keeps almost
    # all of the regex parsing very simple and localized right here.  A
    # disadvantage is that in some extremely rare instances we will have to go
    # back and split a pre-token.

    # Return parameters:
    my @tokens    = ();     # array of the tokens themselves
    my @token_map = (0);    # string position of start of each token
    my @type      = ();     # 'b'=whitespace, 'd'=digits, 'w'=alpha, or punct

    if ( !$max_tokens_wanted ) { $max_tokens_wanted = -1 }

    while ( $max_tokens_wanted-- ) {

        if (
            $str =~ m{
                          \G(
                              (\s+) #     type 'b'  = whitespace - this must come before \W
                          | (\W)  #  or type=char = single-character, non-whitespace punct
                          | (\d+) #  or type 'd'  = sequence of digits - must come before \w
                          | (\w+) #  or type 'w'  = words not starting with a digit
                          )
                        }gcx
          )
        {
            push @tokens, $1;
            push @type,
              defined($2) ? 'b' : defined($3) ? $1 : defined($4) ? 'd' : 'w';
            push @token_map, pos($str);
        }

        # that's all..
        else {
            return ( \@tokens, \@token_map, \@type );
        }
    } ## end while ( $max_tokens_wanted...)

    return ( \@tokens, \@token_map, \@type );
} ## end sub pre_tokenize

sub show_tokens {

    # This is an uncalled debug routine, saved for reference
    my ( $rtokens, $rtoken_map ) = @_;
    my $num = scalar( @{$rtokens} );

    foreach my $i ( 0 .. $num - 1 ) {
        my $len = length( $rtokens->[$i] );
        print {*STDOUT} "$i:$len:$rtoken_map->[$i]:$rtokens->[$i]:\n";
    }
    return;
} ## end sub show_tokens

sub dump_token_types {
    my ( $class, $fh ) = @_;

    # This should be the latest list of token types in use
    # adding NEW_TOKENS: add a comment here
    $fh->print(<<'END_OF_LIST');

Here is a list of the token types currently used for lines of type 'CODE'.
For the following tokens, the "type" of a token is just the token itself.

.. :: << >> ** && .. || // -> => += -= .= %= &= |= ^= *= <>
( ) <= >= == =~ !~ != ++ -- /= x=
... **= <<= >>= &&= ||= //= <=>
, + - / * | % ! x ~ = \ ? : . < > ^ & ^^

The following additional token types are defined:

 type    meaning
    b    blank (white space)
    {    indent: opening structural curly brace or square bracket or paren
         (code block, anonymous hash reference, or anonymous array reference)
    }    outdent: right structural curly brace or square bracket or paren
    [    left non-structural square bracket (enclosing an array index)
    ]    right non-structural square bracket
    (    left non-structural paren (all but a list right of an =)
    )    right non-structural paren
    L    left non-structural curly brace (enclosing a key)
    R    right non-structural curly brace
    ;    terminal semicolon
    f    indicates a semicolon in a "for" statement
    h    here_doc operator <<
    #    a comment
    Q    indicates a quote or pattern
    q    indicates a qw quote block
    k    a perl keyword
    C    user-defined constant or constant function (with void prototype = ())
    U    user-defined function taking parameters
    G    user-defined function taking block parameter (like grep/map/eval)
    S    sub definition     (reported as type 'i' in older versions)
    P    package definition (reported as type 'i' in older versions)
    t    type indicator such as %,$,@,*,&,sub
    w    bare word (perhaps a subroutine call)
    i    identifier of some type (with leading %, $, @, *, &, sub, -> )
    n    a number
    v    a v-string
    F    a file test operator (like -e)
    Y    File handle
    Z    identifier in indirect object slot: may be file handle, object
    J    LABEL:  code block label
    j    LABEL after next, last, redo, goto
    p    unary +
    m    unary -
    pp   pre-increment operator ++
    mm   pre-decrement operator --
    A    : used as attribute separator

    Here are the '_line_type' codes used internally:
    SYSTEM         - system-specific code before hash-bang line
    CODE           - line of perl code (including comments)
    POD_START      - line starting pod, such as '=head'
    POD            - pod documentation text
    POD_END        - last line of pod section, '=cut'
    HERE           - text of here-document
    HERE_END       - last line of here-doc (target word)
    FORMAT         - format section
    FORMAT_END     - last line of format section, '.'
    SKIP           - code skipping section
    SKIP_END       - last line of code skipping section, '#>>V'
    DATA_START     - __DATA__ line
    DATA           - unidentified text following __DATA__
    END_START      - __END__ line
    END            - unidentified text following __END__
    ERROR          - we are in big trouble, probably not a perl script
END_OF_LIST

    return;
} ## end sub dump_token_types

#------------------
# About Token Types
#------------------

# The array "valid_token_types" in the BEGIN section has an up-to-date list
# of token types.  Sub 'dump_token_types' should be kept up to date with
# token types.

# Ideally, tokens are the smallest pieces of text
# such that a newline may be inserted between any pair of tokens without
# changing or invalidating the program. This version comes close to this,
# although there are necessarily a few exceptions which must be caught by
# the formatter.  Many of these involve the treatment of bare words.
#
# To simplify things, token types are either a single character, or they
# are identical to the tokens themselves.
#
# As a debugging aid, the -D flag creates a file containing a side-by-side
# comparison of the input string and its tokenization for each line of a file.
# This is an invaluable debugging aid.
#
# In addition to tokens, and some associated quantities, the tokenizer
# also returns flags indication any special line types.  These include
# quotes, here_docs, formats.
#
#------------------
# Adding NEW_TOKENS
#------------------
#
# Here are some notes on the minimal steps.  I wrote these notes while
# adding the 'v' token type for v-strings, which are things like version
# numbers 5.6.0, and ip addresses, and will use that as an example.  ( You
# can use your editor to search for the string "NEW_TOKENS" to find the
# appropriate sections to change):

# *. For another example, search for the smartmatch operator '~~'
# with your editor to see where updates were made for it.

# *. For another example, search for the string 'c250', which shows
# locations where changes for new types 'P' and 'S' were made.

# *. Think of a new, unused character for the token type, and add to
# the array @valid_token_types in the BEGIN section of this package.
# For example, I used 'v' for v-strings.
#
# *. Implement coding to recognize the $type of the token in this routine.
# This is the hardest part, and is best done by imitating or modifying
# some of the existing coding.  For example, to recognize v-strings, I
# patched 'sub scan_bare_identifier' to recognize v-strings beginning with
# 'v' and 'sub scan_number' to recognize v-strings without the leading 'v'.
#
# *. Update sub operator_expected.  This update is critically important but
# the coding is trivial.  Look at the comments in that routine for help.
# For v-strings, which should behave like numbers, I just added 'v' to the
# regex used to handle numbers and strings (types 'n' and 'Q').
#
# *. Implement a 'bond strength' rule in sub set_bond_strengths in
# Perl::Tidy::Formatter for breaking lines around this token type.  You can
# skip this step and take the default at first, then adjust later to get
# desired results.  For adding type 'v', I looked at sub bond_strength and
# saw that number type 'n' was using default strengths, so I didn't do
# anything.  I may tune it up someday if I don't like the way line
# breaks with v-strings look.
#
# *. Implement a 'whitespace' rule in sub set_whitespace_flags in
# Perl::Tidy::Formatter.  For adding type 'v', I looked at this routine
# and saw that type 'n' used spaces on both sides, so I just added 'v'
# to the array @spaces_both_sides.
#
# *. Update HtmlWriter package so that users can colorize the token as
# desired.  This is quite easy; see comments identified by 'NEW_TOKENS' in
# that package.  For v-strings, I initially chose to use a default color
# equal to the default for numbers, but it might be nice to change that
# eventually.
#
# *. Update comments in Perl::Tidy::Tokenizer::dump_token_types.
#
# *. Run lots and lots of debug tests.  Start with special files designed
# to test the new token type.  Run with the -D flag to create a .DEBUG
# file which shows the tokenization.  When these work ok, test as many old
# scripts as possible.  Start with all of the '.t' files in the 'test'
# directory of the distribution file.  Compare .tdy output with previous
# version and updated version to see the differences.  Then include as
# many more files as possible. My own technique has been to collect a huge
# number of perl scripts (thousands!) into one directory and run perltidy
# *, then run diff between the output of the previous version and the
# current version.

BEGIN {

    # These names are used in error messages
    @opening_brace_names = qw# '{' '[' '(' '?' #;
    @closing_brace_names = qw# '}' ']' ')' ':' #;

    my @q;

    my @digraphs = qw#
      .. :: << >> ** && || // -> => += -= .= %= &= |= ^= *= <>
      <= >= == =~ !~ != ++ -- /= x= ~~ ~. |. &. ^. ^^
      #;
    $is_digraph{$_} = 1 for @digraphs;

    @q = qw(
      . : < > * & | / - = + -  %  ^ !  x ~
    );
    $can_start_digraph{$_} = 1 for @q;

    my @trigraphs =
      qw( ... **= <<= >>= &&= ||= //= <=> !~~ &.= |.= ^.= <<~ ^^= );
    $is_trigraph{$_} = 1 for @trigraphs;

    my @tetragraphs = qw( <<>> );
    $is_tetragraph{$_} = 1 for @tetragraphs;

    # make a hash of all valid token types for self-checking the tokenizer
    # (adding NEW_TOKENS : select a new character and add to this list)
    # fix for c250: added new token type 'P' and 'S'
    my @valid_token_types = qw#
      A b C G L R f h Q k t w i q n p m F pp mm U j J Y Z v P S
      { } ( ) [ ] ; + - / * | % ! x ~ = ? : . < > ^ &
      #;
    push @valid_token_types, BACKSLASH;
    push( @valid_token_types, @digraphs );
    push( @valid_token_types, @trigraphs );
    push( @valid_token_types, @tetragraphs );
    push( @valid_token_types, ( '#', COMMA, 'CORE::' ) );
    $is_valid_token_type{$_} = 1 for @valid_token_types;

    # a list of file test letters, as in -e (Table 3-4 of 'camel 3')
    my @file_test_operators =
      qw( A B C M O R S T W X b c d e f g k l o p r s t u w x z );
    $is_file_test_operator{$_} = 1 for @file_test_operators;

    # these functions have prototypes of the form (&), so when they are
    # followed by a block, that block MAY BE followed by an operator.
    # Smartmatch operator ~~ may be followed by anonymous hash or array ref
    @q = qw( do eval );
    $is_block_operator{$_} = 1 for @q;

    # these functions allow an identifier in the indirect object slot
    @q = qw( print printf sort exec system say );
    $is_indirect_object_taker{$_} = 1 for @q;

    # Keywords which definitely produce error if an OPERATOR is expected
    @q = qw( my our state local use require );
    $is_TERM_keyword{$_} = 1 for @q;

    # Note: 'field' will be added by sub check_options if --use-feature=class
    @q = qw( my our state );
    $is_my_our_state{$_} = 1 for @q;

    # These tokens may precede a code block
    # patched for SWITCH/CASE/CATCH.  Actually these could be removed
    # now and we could let the extended-syntax coding handle them.
    # Added 'default' for Switch::Plain.
    # Note: 'ADJUST' will be added by sub check_options if --use-feature=class
    @q = qw(
      BEGIN     END      CHECK INIT   AUTOLOAD DESTROY
      UNITCHECK continue if    elsif  else     unless
      do        while    until eval   for      foreach
      map       grep     sort  switch case     given
      when      default  catch try    finally
    );
    $is_code_block_token{$_} = 1 for @q;

    # These block types terminate statements and do not need a trailing
    # semicolon; patched for SWITCH/CASE/;  This may be updated in sub
    # check_options.
    @q = qw( } { BEGIN END CHECK INIT AUTOLOAD DESTROY UNITCHECK continue ;
      if elsif else unless while until for foreach switch case given when );
    $is_zero_continuation_block_type{$_} = 1 for @q;

    # Note: this hash was formerly named '%is_not_zero_continuation_block_type'
    # to contrast it with the block types in '%is_zero_continuation_block_type'
    # Note: added 'sub' for anonymous sub blocks (c443)
    @q = qw( sort map grep eval do sub );
    $is_sort_map_grep_eval_do_sub{$_} = 1 for @q;

    @q = qw( sort map grep );
    $is_sort_map_grep{$_} = 1 for @q;

    %is_grep_alias = ();

    # I'll build the list of keywords incrementally
    my @Keywords = ();

    # keywords and tokens after which a value or pattern is expected,
    # but not an operator.  In other words, these should consume terms
    # to their right, or at least they are not expected to be followed
    # immediately by operators.
    my @value_requestor = qw(
      AUTOLOAD         BEGIN         CHECK        DESTROY
      END              EQ            GE           GT
      INIT             LE            LT           NE
      UNITCHECK        abs           accept       alarm
      and              atan2         bind         binmode
      bless            break         caller       chdir
      chmod            chomp         chop         chown
      chr              chroot        close        closedir
      cmp              connect       continue     cos
      crypt            dbmclose      dbmopen      defined
      delete           die           dump         each
      else             elsif         eof          eq
      evalbytes        exec          exists       exit
      exp              fc            fcntl        fileno
      flock            for           foreach      formline
      ge               getc          getgrgid     getgrnam
      gethostbyaddr    gethostbyname getnetbyaddr getnetbyname
      getpeername      getpgrp       getpriority  getprotobyname
      getprotobynumber getpwnam      getpwuid     getservbyname
      getservbyport    getsockname   getsockopt   glob
      gmtime           goto          grep         gt
      hex              if            index        int
      ioctl            join          keys         kill
      last             lc            lcfirst      le
      length           link          listen       local
      localtime        lock          log          lstat
      lt               map           mkdir        msgctl
      msgget           msgrcv        msgsnd       my
      ne               next          no           not
      oct              open          opendir      or
      ord              our           pack         pipe
      pop              pos           print        printf
      prototype        push          quotemeta    rand
      read             readdir       readlink     readline
      readpipe         recv          redo         ref
      rename           require       reset        return
      reverse          rewinddir     rindex       rmdir
      scalar           seek          seekdir      select
      semctl           semget        semop        send
      sethostent       setnetent     setpgrp      setpriority
      setprotoent      setservent    setsockopt   shift
      shmctl           shmget        shmread      shmwrite
      shutdown         sin           sleep        socket
      socketpair       sort          splice       split
      sprintf          sqrt          srand        stat
      state            study         substr       symlink
      syscall          sysopen       sysread      sysseek
      system           syswrite      tell         telldir
      tie              tied          truncate     uc
      ucfirst          umask         undef        unless
      unlink           unpack        unshift      untie
      until            use           utime        values
      vec              waitpid       warn         while
      write            xor           case         catch
      default          err           given        isa
      say              switch        when
    );

    # Note: 'ADJUST', 'field' are added by sub check_options
    # if --use-feature=class

    # patched above for SWITCH/CASE given/when err say
    # 'err' is a fairly safe addition.
    # Added 'default' for Switch::Plain. Note that we could also have
    # a separate set of keywords to include if we see 'use Switch::Plain'
    push( @Keywords, @value_requestor );

    # These are treated the same but are not keywords:
    my @extra_vr = qw( constant vars );
    push( @value_requestor, @extra_vr );

    $expecting_term_token{$_} = 1 for @value_requestor;

    # this list contains keywords which do not look for arguments,
    # so that they might be followed by an operator, or at least
    # not a term.
    my @operator_requestor = qw(
      endgrent    endhostent endnetent  endprotoent
      endpwent    endservent fork       getgrent
      gethostent  getlogin   getnetent  getppid
      getprotoent getpwent   getservent setgrent
      setpwent    time       times      wait
      wantarray
    );

    push( @Keywords, @operator_requestor );

    # These are treated the same but are not considered keywords:
    my @extra_or = qw( STDERR STDIN STDOUT );

    push( @operator_requestor, @extra_or );

    $expecting_operator_token{$_} = 1 for @operator_requestor;

    # these token TYPES expect trailing operator but not a term
    # note: ++ and -- are post-increment and decrement, 'C' = constant
    my @operator_requestor_types = qw( ++ -- C <> q );

    # NOTE: This hash is available but not currently used
    $expecting_operator_types{$_} = 1 for @operator_requestor_types;

    # these token TYPES consume values (terms)
    # note: pp and mm are pre-increment and decrement
    # f=semicolon in for,  F=file test operator
    my @value_requestor_type = qw#
      L { ( [ ~ !~ =~ ; . .. ... A : && ! || // = + - x
      **= += -= .= /= *= %= x= &= |= ^= <<= >>= &&= ||= //=
      <= >= == != => > < % * / ? & | ** <=> ~~ !~~ <<~
      f F pp mm Y p m U J G j >> << ^ t
      ~. ^. |. &. ^.= |.= &.= ^^
      #;
    push @value_requestor_type, BACKSLASH;
    push @value_requestor_type, COMMA;

    # NOTE: This hash is available but not currently used
    $expecting_term_types{$_} = 1 for @value_requestor_type;

    # Note: the following valid token types are not assigned here to
    # hashes requesting to be followed by values or terms, but are
    # instead currently hard-coded into sub operator_expected:
    # ) -> :: Q R Z ] b h i k n v w } #

    # A syntax error will occur if following operators are not followed by a
    # TERM (with an exception made for tokens in sub signatures).
    # NOTE: this list does not include unary operator '!'

    # Note the following omissions from the syntax checking operators below
    # 'U' = user sub, depends on prototype
    # 'F' = file test works on $_ if no following term
    # 'Y' = indirect object, too risky to check syntax

    my @binary_ops = qw#
      !~ =~ . .. : && || // = + - x
      **= += -= .= /= *= %= x= &= |= ^= <<= >>= &&= ||= //=
      <= >= == != > < % * / ? & | ** <=> ~~ !~~ <<~
      >> << ^
      ^. |. &. ^.= |.= &.= ^^
      #;
    $is_binary_operator_type{$_} = 1 for @binary_ops;

    # Note: omitting unary file test type 'F' here because it assumes $_
    my @unary_ops = qw# ! ~ ~. m p mm pp #;
    $is_binary_operator_type{$_} = 1 for @binary_ops;
    push @unary_ops, BACKSLASH;
    $is_binary_or_unary_operator_type{$_} = 1 for ( @binary_ops, @unary_ops );

    # added xor ge gt le lt ( git #206 )
    my @binary_keywords = qw( and or err eq ne cmp xor ge gt le lt );
    $is_binary_keyword{$_} = 1 for @binary_keywords;

    $is_binary_or_unary_keyword{$_} = 1 for ( @binary_keywords, 'not' );

    # A syntax error occurs if a binary operator follows any of these types:
    # NOTE: a ',' cannot be included because of parenless calls (c015).
    # For example this is valid: print "hello\n", && print "goodbye\n";
    # NOTE: the 'not' keyword could be added to a corresponding _keyword list
    # NOTE: label 'j' omitted, for example: -f $file ? redo BLOCK : last BLOCK;
    # NOTE: Removed 'A': fixes git162.t
    @q = qw< L { [ ( ; f J t >;
    $is_not_a_TERM_producer_type{$_} = 1 for ( @q, @unary_ops );

    @q = qw( q qq qx qr s y tr m );
    $is_q_qq_qx_qr_s_y_tr_m{$_} = 1 for @q;

    # Note added 'qw' here
    @q = qw( q qq qw qx qr s y tr m );
    $is_q_qq_qw_qx_qr_s_y_tr_m{$_} = 1 for @q;

    # Quote modifiers:
    # original ref: camel 3 p 147,
    # but perl may accept undocumented flags
    # perl 5.10 adds 'p' (preserve)
    # Perl version 5.22 added 'n'
    # From http://perldoc.perl.org/perlop.html we have
    # /PATTERN/msixpodualngc or m?PATTERN?msixpodualngc
    # s/PATTERN/REPLACEMENT/msixpodualngcer
    # y/SEARCHLIST/REPLACEMENTLIST/cdsr
    # tr/SEARCHLIST/REPLACEMENTLIST/cdsr
    # qr/STRING/msixpodualn
    %quote_modifiers = (
        's'  => '[msixpodualngcer]',
        'y'  => '[cdsr]',
        'tr' => '[cdsr]',
        'm'  => '[msixpodualngc]',
        'qr' => '[msixpodualn]',
        'q'  => EMPTY_STRING,
        'qq' => EMPTY_STRING,
        'qw' => EMPTY_STRING,
        'qx' => EMPTY_STRING,
    );

    # Note: 'class' will be added by sub check_options if -use-feature=class
    @q = qw( package );
    $is_package{$_} = 1 for @q;

    @q = qw( if elsif unless );
    $is_if_elsif_unless{$_} = 1 for @q;

    @q = qw( ; t );
    $is_semicolon_or_t{$_} = 1 for @q;

    @q = qw( if elsif unless case when );
    $is_if_elsif_unless_case_when{$_} = 1 for @q;

    # Hash of other possible line endings which may occur.
    # Keep these coordinated with the regex where this is used.
    # Note: chr(13) = chr(015)="\r".
    @q = ( chr(13), chr(29), chr(26) );
    $other_line_endings{$_} = 1 for @q;

    # These keywords are handled specially in the tokenizer code:
    my @special_keywords =
      qw( do eval format m package q qq qr qw qx s sub tr y );
    push( @Keywords, @special_keywords );

    # Keywords after which list formatting may be used
    # WARNING: do not include |map|grep|eval or perl may die on
    # syntax errors (map1.t).
    my @keyword_taking_list = qw(
      and        chmod      chomp      chop
      chown      dbmopen    die        elsif
      exec       fcntl      for        foreach
      formline   getsockopt given      if
      index      ioctl      join       kill
      local      msgctl     msgrcv     msgsnd
      my         open       or         our
      pack       print      printf     push
      read       readpipe   recv       return
      reverse    rindex     seek       select
      semctl     semget     send       setpriority
      setsockopt shmctl     shmget     shmread
      shmwrite   socket     socketpair sort
      splice     split      sprintf    state
      substr     syscall    sysopen    sysread
      sysseek    system     syswrite   tie
      unless     unlink     unpack     unshift
      until      vec        warn       when
      while
    );

    # NOTE: This hash is available but not currently used
    $is_keyword_taking_list{$_} = 1 for @keyword_taking_list;

    # perl functions which may be unary operators.

    # This list is used to decide if a pattern delimited by slashes, /pattern/,
    # can follow one of these keywords.
    @q = qw( chomp eof eval fc lc pop shift uc undef );

    $is_keyword_rejecting_slash_as_pattern_delimiter{$_} = 1 for @q;

    # These are keywords for which an arg may optionally be omitted.  They are
    # currently only used to disambiguate a ? used as a ternary from one used
    # as a (deprecated) pattern delimiter.  In the future, they might be used
    # to give a warning about ambiguous syntax before a /.
    # Note: split has been omitted (see note below).
    my @keywords_taking_optional_arg = qw(
      abs      alarm    caller    chdir     chomp   chop
      chr      chroot   close     cos       defined die
      eof      eval     evalbytes exit      exp     fc
      getc     glob     gmtime    hex       int     last
      lc       lcfirst  length    localtime log     lstat
      mkdir    next     oct       ord       pop     pos
      print    printf   prototype quotemeta rand    readline
      readlink readpipe redo      ref       require reset
      reverse  rmdir    say       select    shift   sin
      sleep    sqrt     srand     stat      study   tell
      uc       ucfirst  umask     undef     unlink  warn
      write
    );
    $is_keyword_taking_optional_arg{$_} = 1 for @keywords_taking_optional_arg;

    # This list is used to decide if a pattern delimited by question marks,
    # ?pattern?, can follow one of these keywords.  Note that from perl 5.22
    # on, a ?pattern? is not recognized, so we can be much more strict than
    # with a /pattern/. Note that 'split' is not in this list. In current
    # versions of perl a question following split must be a ternary, but
    # in older versions it could be a pattern.  The guessing algorithm will
    # decide.  We are combining two lists here to simplify the test.
    @q = ( @keywords_taking_optional_arg, @operator_requestor );
    $is_keyword_rejecting_question_as_pattern_delimiter{$_} = 1 for @q;

    # These are not used in any way yet
    #    my @unused_keywords = qw(
    #     __FILE__
    #     __LINE__
    #     __PACKAGE__
    #     );

    #  The list of keywords was originally extracted from function 'keyword' in
    #  perl file toke.c version 5.005.03, using this utility, plus a
    #  little editing: (file getkwd.pl):
    #  while (<>) { while (/\"(.*)\"/g) { print "$1\n"; } }
    #  Add 'get' prefix where necessary, then split into the above lists.
    #  This list should be updated as necessary.
    #  The list should not contain these special variables:
    #  ARGV DATA ENV SIG STDERR STDIN STDOUT
    #  __DATA__ __END__

    $is_keyword{$_} = 1 for @Keywords;

    %matching_end_token = (
        '{' => '}',
        '(' => ')',
        '[' => ']',
        '<' => '>',
    );
} ## end BEGIN

} ## end package Perl::Tidy::Tokenizer
1;