#!/usr/bin/perl
package main;
-
use Perl::Tidy;
my $arg_string = undef;
# except if there has been a bug introduced by a recent program change.
# Please add comments at calls to Fault to explain why the call
# should not occur, and where to look to fix it.
- my ( $package0, $filename0, $line0, $subroutine0 ) = caller(0);
- my ( $package1, $filename1, $line1, $subroutine1 ) = caller(1);
- my ( $package2, $filename2, $line2, $subroutine2 ) = caller(2);
+ my ( $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 = $rstatus->{'input_name'};
# add option to change path here
if ( defined( $rOpts->{'output-path'} ) ) {
- my ( $base, $old_path ) = fileparse($fileroot);
+ my ( $base, $old_path_uu ) = fileparse($fileroot);
my $new_path = $rOpts->{'output-path'};
if ( !-d $new_path ) {
mkdir($new_path) # Default MODE is 0777
my @q = @_;
my (
- $perltidyrc_stream, $is_Windows, $Windows_type,
- $rpending_complaint, $dump_options_type
+ $perltidyrc_stream, $is_Windows_uu, $Windows_type_uu,
+ $rpending_complaint_uu, $dump_options_type
) = @q;
my $use_cache = !defined($perltidyrc_stream) && !$dump_options_type;
if ($is_Windows) {
if ($Windows_type) {
- my ( $os, $system, $allusers ) =
+ my ( $os_uu, $system, $allusers ) =
Win_Config_Locs( $rpending_complaint, $Windows_type );
# Check All Users directory, if there is one.
# to the .DEBUG file when the -D flag is entered.
my ( $self, $line_of_tokens ) = @_;
- my $input_line = $line_of_tokens->{_line_text};
-
- my $rtoken_type = $line_of_tokens->{_rtoken_type};
- my $rtokens = $line_of_tokens->{_rtokens};
- my $rlevels = $line_of_tokens->{_rlevels};
-
+ my $rtoken_type = $line_of_tokens->{_rtoken_type};
+ my $rtokens = $line_of_tokens->{_rtokens};
my $input_line_number = $line_of_tokens->{_line_number};
- my $line_type = $line_of_tokens->{_line_type};
+
+## uncomment if needed:
+## my $input_line = $line_of_tokens->{_line_text};
+## my $rlevels = $line_of_tokens->{_rlevels};
+## my $line_type = $line_of_tokens->{_line_type};
my $token_str = "$input_line_number: ";
my $reconstructed_original = "$input_line_number: ";
# except if there has been a bug introduced by a recent program change.
# Please add comments at calls to Fault to explain why the call
# should not occur, and where to look to fix it.
- my ( $package0, $filename0, $line0, $subroutine0 ) = caller(0);
- my ( $package1, $filename1, $line1, $subroutine1 ) = caller(1);
- my ( $package2, $filename2, $line2, $subroutine2 ) = caller(2);
+ my ( $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__;
# Catch potential error of Fault not called as a method
# except if there has been a bug introduced by a recent program change.
# Please add comments at calls to Fault to explain why the call
# should not occur, and where to look to fix it.
- my ( $package0, $filename0, $line0, $subroutine0 ) = caller(0);
- my ( $package1, $filename1, $line1, $subroutine1 ) = caller(1);
- my ( $package2, $filename2, $line2, $subroutine2 ) = caller(2);
+ my ( $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 = get_input_stream_name();
# This is the same as Fault except that it calls Warn instead of Die
# and returns.
- my ( $package0, $filename0, $line0, $subroutine0 ) = caller(0);
- my ( $package1, $filename1, $line1, $subroutine1 ) = caller(1);
- my ( $package2, $filename2, $line2, $subroutine2 ) = caller(2);
+ 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 $input_stream_name = get_input_stream_name();
Warn(<<EOM);
# See if a pattern will compile.
# Note: this sub is also called from Tokenizer
- my $regex = eval { qr/$pattern/ };
+ my $regex_uu = eval { qr/$pattern/ };
return $EVAL_ERROR;
} ## end sub bad_pattern
last if ( $line_type ne 'CODE' );
my $rK_range = $line_of_tokens->{_rK_range};
- my ( $Kfirst, $Klast ) = @{$rK_range};
+ my ( $Kfirst, $Klast_uu ) = @{$rK_range};
# skip a blank line
next if ( !defined($Kfirst) );
my $line_type = $line_of_tokens->{_line_type};
if ( $line_type eq 'CODE' ) {
- my ( $Kfirst, $Klast ) = @{ $line_of_tokens->{_rK_range} };
+ my ( $Kfirst_uu, $Klast ) = @{ $line_of_tokens->{_rK_range} };
if ($Klast) {
my $type = $rLL->[$Klast]->[_TYPE_];
if ( $type eq '#' ) {
}
}
}
+ return;
}; ## end $check_for_overlapping_variables = sub
#--------------------------------
# --$KK --$seqno of brace that we want
#
if ( $rLL->[$K_n]->[_TOKEN_] eq 'elsif' ) {
- ( $seqno_block, my $K_last_iterator ) =
+ ( $seqno_block, my $K_last_iterator_uu ) =
$self->block_seqno_of_paren_keyword($K_n);
}
my $rtype_count_pp = $self->[_rtype_count_by_seqno_]->{$seqno_pp};
return unless ($rtype_count_pp);
$comma_count_inner = $rtype_count_pp->{','};
- my $fat_comma_count_inner = $rtype_count_pp->{'=>'};
+## my $fat_comma_count_inner = $rtype_count_pp->{'=>'};
return if ( !$comma_count_inner );
return if ( $comma_count_inner < 2 );
# Set the counts to undef in case we have to do a simple return upon
# encountering an indeterminate list count
my $shift_count_min_input = $rarg_list->{shift_count_min};
- my $shift_count_max_input = $rarg_list->{shift_count_max};
+## my $shift_count_max_input = $rarg_list->{shift_count_max};
$rarg_list->{shift_count_min} = undef;
$rarg_list->{shift_count_max} = undef;
foreach ( @{$rKlist} ) {
my $K_return = $rLL->[$_]->[_TYPE_] eq 'b' ? $_ + 1 : $_;
- my $type = $rLL->[$K_return]->[_TYPE_];
- my $token = $rLL->[$K_return]->[_TOKEN_];
+## my $type = $rLL->[$K_return]->[_TYPE_];
+ my $token = $rLL->[$K_return]->[_TOKEN_];
if ( $token ne 'return' ) {
DEVEL_MODE && Fault("expecting 'return' but got $token\n");
last;
@debug_warnings = sort { $a->{Ko} <=> $b->{Ko} } @debug_warnings;
my $output_string = EMPTY_STRING;
foreach my $item (@debug_warnings) {
- my $caller_name = $item->{caller_name};
+## my $caller_name = $item->{caller_name};
my $parent_self = $item->{parent_self};
my $receiver_self = $item->{receiver_self};
my $sub_called = $item->{sub_called};
$name = $rsub_item->{name};
$lno = $rsub_item->{line_number};
- my $rK_return_list = $item->{rK_return_list};
- my $rself_calls = $item->{self_calls};
- my $rdirect_calls = $item->{direct_calls};
- my $num_self = defined($rself_calls) ? @{$rself_calls} : 0;
- my $num_direct = defined($rdirect_calls) ? @{$rdirect_calls} : 0;
+## my $rK_return_list = $item->{rK_return_list};
+ my $rself_calls = $item->{self_calls};
+ my $rdirect_calls = $item->{direct_calls};
+ my $num_self = defined($rself_calls) ? @{$rself_calls} : 0;
+ my $num_direct = defined($rdirect_calls) ? @{$rdirect_calls} : 0;
- my $K_return_count_min = $rsub_item->{K_return_count_min};
+## my $K_return_count_min = $rsub_item->{K_return_count_min};
my $K_return_count_max = $rsub_item->{K_return_count_max};
$shift_count_min = $rsub_item->{shift_count_min};
my $iline_oo = $rLL->[$Kouter_opening]->[_LINE_INDEX_];
my $rK_range = $rlines->[$iline_oo]->{_rK_range};
- my ( $Kfirst, $Klast ) = @{$rK_range};
+ my ( $Kfirst, $Klast_uu ) = @{$rK_range};
#-------------------------------------------------------------------------
# We now define a reference index, '$Kref', from which to start measuring
if ( $type_prev eq '=>' ) {
my $iline_prev = $rLL->[$Kprev]->[_LINE_INDEX_];
my $rK_range_prev = $rlines->[$iline_prev]->{_rK_range};
- my ( $Kfirst_prev, $Klast_prev ) = @{$rK_range_prev};
+ my ( $Kfirst_prev, $Klast_prev_uu ) = @{$rK_range_prev};
foreach my $KK ( reverse( $Kfirst_prev .. $Kref - 1 ) ) {
next if ( $rLL->[$KK]->[_TYPE_] eq 'b' );
$Kref = $KK;
foreach my $iline ( $iline_oo + 1 .. $iline_io ) {
my $rK_range = $rlines->[$iline]->{_rK_range};
next unless defined($rK_range);
- my ( $Kfirst, $Klast ) = @{$rK_range};
+ my ( $Kfirst, $Klast_uu ) = @{$rK_range};
next unless defined($Kfirst);
if ( $rLL->[$Kfirst]->[_TYPE_] eq '->' ) {
$do_not_weld_rule = 7;
# Check the length of the last line (fixes case b1039)
if ( !$do_not_weld ) {
my $rK_range_ic = $rlines->[$iline_ic]->{_rK_range};
- my ( $Kfirst_ic, $Klast_ic ) = @{$rK_range_ic};
+ my ( $Kfirst_ic, $Klast_ic_uu ) = @{$rK_range_ic};
my $excess_ic =
$self->excess_line_length_for_Krange( $Kfirst_ic,
$Kouter_closing );
my $KK = $K_opening_container->{$seqno};
my $line_of_tokens = $rlines->[$ix];
my $rK_range = $line_of_tokens->{_rK_range};
- my ( $Kfirst, $Klast ) = @{$rK_range};
+ my ( $Kfirst_uu, $Klast ) = @{$rK_range};
$rspecial_side_comment_type->{$Klast} = 'NIB';
push @K_stack, [ $KK, 1 ];
my $Kc = $K_closing_container->{$seqno};
my $iline = $rLL->[$KK]->[_LINE_INDEX_];
my $rK_range = $rlines->[$iline]->{_rK_range};
- my ( $Kfirst, $Klast ) = @{$rK_range};
+ my ( $Kfirst, $Klast_uu ) = @{$rK_range};
next unless ( $KK == $Kfirst );
}
# get updated indentation levels
my $rK_range = $line_of_tokens->{_rK_range};
- my ( $K_first, $K_last ) = @{$rK_range};
- if ( defined($K_first) ) {
- my $level_0 = $self->[_radjusted_levels_]->[$K_first];
+ my ( $Kfirst, $Klast_uu ) = @{$rK_range};
+ if ( defined($Kfirst) ) {
+ my $level_0 = $self->[_radjusted_levels_]->[$Kfirst];
my $ci_level_0 =
- $self->[_rLL_]->[$K_first]->[_CI_LEVEL_];
+ $self->[_rLL_]->[$Kfirst]->[_CI_LEVEL_];
$line_of_tokens->{_level_0} = $level_0;
$line_of_tokens->{_ci_level_0} = $ci_level_0;
}
my $j_e = $subgroup[$k] - 1;
# index i is the actual line number of a keyword
- my ( $i_b, $tok_b, $count_b ) = @{ $group[$j_b] };
- my ( $i_e, $tok_e, $count_e ) = @{ $group[$j_e] };
+ my ( $i_b, $tok_b_uu, $count_b ) = @{ $group[$j_b] };
+ my ( $i_e_uu, $tok_e_uu, $count_e ) = @{ $group[$j_e] };
my $num = $count_e - $count_b + 1;
# This subgroup runs from line $ib to line $ie-1, but may contain
my $nog_b = my $nog_e = 1;
if ( @iblanks && !$rOpts_kgb_delete ) {
my $j_bb = $j_b + $num - 1;
- my ( $i_bb, $tok_bb, $count_bb ) = @{ $group[$j_bb] };
+ my ( $i_bb_uu, $tok_bb_uu, $count_bb ) = @{ $group[$j_bb] };
$nog_b = $count_bb - $count_b + 1 == $num;
my $j_ee = $j_e - ( $num - 1 );
- my ( $i_ee, $tok_ee, $count_ee ) = @{ $group[$j_ee] };
+ my ( $i_ee_uu, $tok_ee_uu, $count_ee ) = @{ $group[$j_ee] };
$nog_e = $count_e - $count_ee + 1 == $num;
}
if ( $nog_b && $k > $kbeg ) {
kgb_insert_blank_after( $i_b - 1 );
}
if ( $nog_e && $k < $kend ) {
- my ( $i_ep, $tok_ep, $count_ep ) =
+ my ( $i_ep, $tok_ep_uu, $count_ep_uu ) =
@{ $group[ $j_e + 1 ] };
kgb_insert_blank_after( $i_ep - 1 );
}
}
DEBUG_STORE && do {
- my ( $a, $b, $c ) = caller();
+ my ( $pkg, $file_uu, $lno ) = caller();
print {*STDOUT}
-"STORE: from $a $c: storing token $token type $type lev=$level at $max_index_to_go\n";
+"STORE: from $pkg $lno: storing token $token type $type lev=$level at $max_index_to_go\n";
};
return;
} ## end sub store_token_to_go
}
DEBUG_FORCE && do {
- my ( $a, $b, $c ) = caller();
+ my ( $pkg, $file_uu, $lno ) = caller();
my $msg =
-"FORCE $forced_breakpoint_count after call from $a $c with i=$i max=$max_index_to_go";
+"FORCE $forced_breakpoint_count after call from $pkg $lno with i=$i max=$max_index_to_go";
if ( !defined($i_nonblank) ) {
$i = EMPTY_STRING unless defined($i);
$msg .= " but could not set break after i='$i'\n";
if ( $i_start < 0 ) {
$i_start = 0;
- my ( $a, $b, $c ) = caller();
+ my ( $pkg, $file_uu, $lno ) = caller();
# Bad call, can only be due to a recent programming change.
Fault(
-"Program Bug: undo_forced_breakpoint_stack from $a $c has bad i=$i_start "
+"Program Bug: undo_forced_breakpoint_stack from $pkg $lno has bad i=$i_start "
) if (DEVEL_MODE);
return;
}
$forced_breakpoint_count--;
DEBUG_UNDOBP && do {
- my ( $a, $b, $c ) = caller();
+ my ( $pkg, $file_uu, $lno ) = caller();
print {*STDOUT}
-"UNDOBP: undo forced_breakpoint i=$i $forced_breakpoint_undo_count from $a $c max=$max_index_to_go\n";
+"UNDOBP: undo forced_breakpoint i=$i $forced_breakpoint_undo_count from $pkg $lno max=$max_index_to_go\n";
};
}
# shouldn't happen, but not a critical error
else {
if (DEVEL_MODE) {
- my ( $a, $b, $c ) = caller();
+ my ( $pkg, $file_uu, $lno ) = caller();
Fault(<<EOM);
-Program Bug: undo_forced_breakpoint from $a $c has i=$i but max=$max_index_to_go
+Program Bug: undo_forced_breakpoint from $pkg $lno has i=$i but max=$max_index_to_go
EOM
}
}
my $nmax = @{$ri_end} - 1;
my $ibeg_1 = $ri_beg->[ $n - 1 ];
my $iend_1 = $ri_end->[ $n - 1 ];
- my $ibeg_2 = $ri_beg->[$n];
+## my $ibeg_2 = $ri_beg->[$n];
my $iend_2 = $ri_end->[$n];
if ($itok) {
$actual_pos = $predicted_pos;
- my ( $indent, $offset, $is_leading, $exists ) =
+ my ( $indent, $offset, $is_leading_uu, $exists_uu ) =
get_saved_opening_indentation($align_seqno);
if ( defined($indent) ) {
if ( $available_spaces > 0 ) {
my $delete_want = min( $available_spaces, $excess );
- my $deleted_spaces =
+ my $deleted_spaces_uu =
$self->reduce_lp_indentation( $ibeg, $delete_want );
$available_spaces = $self->get_available_spaces_to_go($ibeg);
}
my $identifier_count = $rhash_A->{_identifier_count_A};
# Derived variables:
- my $ritem_lengths = $rhash_A->{_ritem_lengths};
- my $ri_term_begin = $rhash_A->{_ri_term_begin};
- my $ri_term_end = $rhash_A->{_ri_term_end};
+## my $ritem_lengths = $rhash_A->{_ritem_lengths};
+## my $ri_term_begin = $rhash_A->{_ri_term_begin};
+## my $ri_term_end = $rhash_A->{_ri_term_end};
my $ri_term_comma = $rhash_A->{_ri_term_comma};
my $rmax_length = $rhash_A->{_rmax_length};
my $comma_count = $rhash_A->{_comma_count};
my $first_term_length = $rhash_A->{_first_term_length};
my $i_first_comma = $rhash_A->{_i_first_comma};
my $i_last_comma = $rhash_A->{_i_last_comma};
- my $i_true_last_comma = $rhash_A->{_i_true_last_comma};
+## my $i_true_last_comma = $rhash_A->{_i_true_last_comma};
# Variables received from caller
- my $i_opening_paren = $rhash_IN->{i_opening_paren};
- my $i_closing_paren = $rhash_IN->{i_closing_paren};
- my $rcomma_index = $rhash_IN->{rcomma_index};
- my $next_nonblank_type = $rhash_IN->{next_nonblank_type};
- my $list_type = $rhash_IN->{list_type};
- my $interrupted = $rhash_IN->{interrupted};
+ my $i_opening_paren = $rhash_IN->{i_opening_paren};
+## my $i_closing_paren = $rhash_IN->{i_closing_paren};
+ my $rcomma_index = $rhash_IN->{rcomma_index};
+ my $next_nonblank_type = $rhash_IN->{next_nonblank_type};
+ my $list_type = $rhash_IN->{list_type};
+## my $interrupted = $rhash_IN->{interrupted};
my $rdo_not_break_apart = $rhash_IN->{rdo_not_break_apart};
my $must_break_open = $rhash_IN->{must_break_open};
$item_count = $hash_B->{_item_count_B};
# New variables
- my $columns = $hash_B->{_columns};
- my $formatted_columns = $hash_B->{_formatted_columns};
- my $formatted_lines = $hash_B->{_formatted_lines};
- my $max_width = $hash_B->{_max_width};
- my $new_identifier_count = $hash_B->{_new_identifier_count};
- my $number_of_fields = $hash_B->{_number_of_fields};
- my $odd_or_even = $hash_B->{_odd_or_even};
+ my $columns = $hash_B->{_columns};
+ my $formatted_columns = $hash_B->{_formatted_columns};
+ my $formatted_lines = $hash_B->{_formatted_lines};
+ my $max_width = $hash_B->{_max_width};
+ my $new_identifier_count = $hash_B->{_new_identifier_count};
+ my $number_of_fields = $hash_B->{_number_of_fields};
+## my $odd_or_even = $hash_B->{_odd_or_even};
my $packed_columns = $hash_B->{_packed_columns};
my $packed_lines = $hash_B->{_packed_lines};
my $pair_width = $hash_B->{_pair_width};
if ( $i >= 0 && $i <= $j && $j <= $max_index_to_go ) {
0 && do {
- my ( $a, $b, $c ) = caller();
+ my ( $pkg, $file_uu, $lno ) = caller();
print {*STDOUT}
-"NOBREAK: forced_breakpoint $forced_breakpoint_count from $a $c with i=$i max=$max_index_to_go type=$types_to_go[$i]\n";
+"NOBREAK: forced_breakpoint $forced_breakpoint_count from $pkg $lno with i=$i max=$max_index_to_go type=$types_to_go[$i]\n";
};
@nobreak_to_go[ $i .. $j ] = (1) x ( $j - $i + 1 );
# shouldn't happen; non-critical error
else {
if (DEVEL_MODE) {
- my ( $a, $b, $c ) = caller();
+ my ( $pkg, $file_uu, $lno ) = caller();
Fault(<<EOM);
-NOBREAK ERROR: from $a $c with i=$i j=$j max=$max_index_to_go
+NOBREAK ERROR: from $pkg $lno with i=$i j=$j max=$max_index_to_go
EOM
}
}
my $ci_level =
$rlp_object_list->[$i_debug]->get_ci_level();
my $old_level = $rlp_object_list->[$i]->get_level();
- my $old_ci_level =
+ my $old_ci_level_uu =
$rlp_object_list->[$i]->get_ci_level();
Fault(<<EOM);
program bug with -lp: want to delete $deleted_spaces from item $i, but old=$old_spaces deleted: lev=$level ci=$ci_level deleted: level=$old_level ci=$ci_level
# one less than the number of fields. If this is not true then
# an error has been introduced in sub make_alignment_patterns.
if (DEVEL_MODE) {
- my ( $rtokens, $rfields, $rpatterns, $rfield_lengths ) =
+ my ( $rtokens, $rfields, $rpatterns_uu, $rfield_lengths_uu ) =
@{$rline_alignment};
if ( @{$rfields} && ( @{$rtokens} != ( @{$rfields} - 1 ) ) ) {
my $nt = @{$rtokens};
my $title = $rOpts->{'title'};
if ( !$title ) {
- ( $title, my $path ) = fileparse($input_file);
+ ( $title, my $path_uu ) = fileparse($input_file);
}
my $toc_item_count = 0;
my $in_toc_package = EMPTY_STRING;
# 3. - the frame which contains them
# get basenames for relative links
- my ( $toc_basename, $toc_path ) = fileparse($toc_filename);
- my ( $src_basename, $src_path ) = fileparse($src_filename);
+ my ( $toc_basename, $toc_path_uu ) = fileparse($toc_filename);
+ my ( $src_basename, $src_path_uu ) = fileparse($src_filename);
# 1. Make the table of contents panel, with appropriate changes
# to the anchor names
- my $src_frame_name = 'SRC';
- my $first_anchor = write_toc_html(
+ my $src_frame_name = 'SRC';
+ my $first_anchor_uu = write_toc_html(
{
title => $title,
toc_filename => $toc_filename,
<h1><a href=\"$src_basename#-top-" target="$src_frame_name">$title</a></h1>
EOM
- my $first_anchor =
+ my $first_anchor_uu =
change_anchor_names( $rtoc, $src_basename, "$src_frame_name" );
$fh->print( join EMPTY_STRING, @{$rtoc} );
# except if there has been a bug introduced by a recent program change.
# Please add comments at calls to Fault to explain why the call
# should not occur, and where to look to fix it.
- my ( $package0, $filename0, $line0, $subroutine0 ) = caller(0);
- my ( $package1, $filename1, $line1, $subroutine1 ) = caller(1);
- my ( $package2, $filename2, $line2, $subroutine2 ) = caller(2);
+ my ( $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__;
# Catch potential error of Fault not called as a method
my $len_1 = length($tok_1);
my $len_2 = length($tok_2);
- my $pre_type_0 = 'w';
+ ##my $pre_type_0 = 'w';
my $pre_type_1 = 'd';
my $pre_type_2 = 'w';
}
# now its safe to report errors
- my $severe_error = $tokenizer->report_tokenization_errors();
+ my $severe_error_uu = $tokenizer->report_tokenization_errors();
# TODO: Could propagate a severe error up
)
{
# For possible future use..
- my $subname = $2;
- my $package = $1 ? $1 : EMPTY_STRING;
+ ##my $subname = $2;
+ ##my $package = $1 ? $1 : EMPTY_STRING;
}
else {
return;
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 ) =
+ ( $next_char, my $i_next_uu ) =
$self->find_next_nonblank_token( $max_token_index,
$rtokens, $max_token_index );
}
)
{
# For possible future use..
- my $subname = $2;
- my $package = $1 ? $1 : EMPTY_STRING;
+ ##my $subname = $2;
+ ##my $package = $1 ? $1 : EMPTY_STRING;
}
else {
return;
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 ) =
+ ( $next_char, my $i_next_uu ) =
$self->find_next_nonblank_token( $max_token_index,
$rtokens, $max_token_index );
}
# 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 ) =
+ 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} );
# 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 ) =
+ my ( $next_nonblank_token, $i_next_uu ) =
$self->find_next_nonblank_token( $i, $rtokens,
$max_token_index );
my $rvars = $rparen_vars->[$paren_depth];
if ( defined($rvars) ) {
$container_type = $rparen_type->[$paren_depth];
- ( my $type_lp, $want_brace ) = @{$rvars};
+ ( my $type_lp_uu, $want_brace ) = @{$rvars};
}
}
my $rvars = $rparen_vars->[$paren_depth];
if ( defined($rvars) ) {
- my ( $type_lp, $want_brace ) = @{$rvars};
+ my ( $type_lp, $want_brace_uu ) = @{$rvars};
if ( $type_lp && $type_lp eq '{' ) {
$type = '}';
}
my $rvars = $rparen_vars->[ $paren_depth + 1 ];
if ( defined($rvars) ) {
- my ( $type_lp, $want_brace ) = @{$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
if ( ( $expecting != OPERATOR )
&& $is_file_test_operator{$next_tok} )
{
- my ( $next_nonblank_token, $i_next ) =
+ my ( $next_nonblank_token, $i_next_uu ) =
$self->find_next_nonblank_token( $i + 1, $rtokens,
$max_token_index );
my $self = shift;
$self->scan_bare_identifier();
- my ( $next_nonblank_tok2, $i_next2 ) =
+ my ( $next_nonblank_tok2, $i_next2_uu ) =
$self->find_next_nonblank_token( $i, $rtokens, $max_token_index );
if ($next_nonblank_tok2) {
&& $expecting != OPERATOR
&& $next_nonblank_token eq ':' )
{
- my ( $nn_nonblank_token, $i_nn ) =
+ my ( $nn_nonblank_token, $i_nn_uu ) =
$self->find_next_nonblank_token( $i_next, $rtokens,
$max_token_index );
$sub_attribute_ok_here =
# done if nothing left to scan on this line
last if ( $i > $max_token_index );
- my ( $next_nonblank_token, $i_next ) =
+ my ( $next_nonblank_token_uu, $i_next ) =
find_next_nonblank_token_on_this_line( $i, $rtokens,
$max_token_index );
# USES GLOBAL VARIABLES: $last_nonblank_token
my ( $self, $i, $rtokens, $rtoken_type, $max_token_index ) = @_;
- my ( $next_nonblank_token, $i_next ) =
+ 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.
# 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 ) =
+ ( $statement_type, my $saved_type, my $saved_token_uu ) =
@{ $rnested_statement_type->[$aa][ $rcurrent_depth->[$aa] ] };
if ( $aa == BRACE
&& $saved_type eq 'Z'
next if ( $line =~ /^#/ ); # skip comment
# Updated from 2 to 3 to get trigraphs, added for case b1175
- my ( $rtok, $rmap, $rtype ) = pre_tokenize( $line, 3 );
+ my ( $rtok, $rmap_uu, $rtype_uu ) = pre_tokenize( $line, 3 );
my $j = $max_token_index + 1;
foreach my $tok ( @{$rtok} ) {
# msg = a warning or diagnostic message
# USES GLOBAL VARIABLES: $last_nonblank_token
- my ( $self, $i, $rtokens, $rtoken_type, $rtoken_map, $max_token_index ) =
- @_;
+ my ( $self, $i, $rtokens, $rtoken_type, $rtoken_map_uu, $max_token_index )
+ = @_;
my $is_pattern = 0;
my $msg = "guessing that ? after $last_nonblank_token starts a ";
else {
my $ibeg = $i;
$i = $ibeg + 1;
- my $next_token = $rtokens->[$i]; # first token after ?
+ ##my $next_token = $rtokens->[$i]; # first token after ?
# look for a possible ending ? on this line..
my $in_quote = 1;
# $is_pattern = 0 if probably division, =1 if probably a pattern
# msg = a warning or diagnostic message
# USES GLOBAL VARIABLES: $last_nonblank_token
- my ( $self, $i, $rtokens, $rtoken_type, $rtoken_map, $max_token_index ) =
- @_;
+ my ( $self, $i, $rtokens, $rtoken_type, $rtoken_map_uu, $max_token_index )
+ = @_;
my $is_pattern = 0;
my $msg = "guessing that / after $last_nonblank_token starts a ";
my $ibeg = $i;
) = @_;
- my $i_begin = $i;
my $package = undef;
my $i_beg = $i;
# package NAMESPACE VERSION
# package NAMESPACE BLOCK
# package NAMESPACE VERSION BLOCK
- my ( $next_nonblank_token, $i_next ) =
+ 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.
}
# check for multiple definitions of a sub
- ( $next_nonblank_token, my $i_next ) =
+ ( $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 ) =
+ 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];
$i++;
}
- my ( $next_nonblank_token, $i_next ) =
+ my ( $next_nonblank_token, $i_next_uu ) =
$self->find_next_nonblank_token( $i, $rtokens, $max_token_index );
if ( $pattern_test{$next_nonblank_token} ) {
@_;
my $pos_beg = $rtoken_map->[$i];
my $pos;
- my $i_begin = $i;
- my $number = undef;
- my $type = $input_type;
+ ##my $i_begin = $i;
+ my $number = undef;
+ my $type = $input_type;
my $first_char = substr( $input_line, $pos_beg, 1 );
$i,
$rtokens,
$rtoken_type,
- $rtoken_map,
+ $rtoken_map_uu,
$max_token_index
) = @_;
$quoted_string_2,
$rtokens,
$rtoken_type,
- $rtoken_map,
+ $rtoken_map_uu,
$max_token_index,
) = @_;
# except if there has been a bug introduced by a recent program change.
# Please add comments at calls to Fault to explain why the call
# should not occur, and where to look to fix it.
- my ( $package0, $filename0, $line0, $subroutine0 ) = caller(0);
- my ( $package1, $filename1, $line1, $subroutine1 ) = caller(1);
- my ( $package2, $filename2, $line2, $subroutine2 ) = caller(2);
+ my ( $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 = get_input_stream_name();
my $pad_length = 0;
foreach my $j ( 0 .. $maximum_field_index - 1 ) {
my $tok = $rtokens_old->[$j];
- my ( $raw_tok, $lev, $tag, $tok_count ) = decode_alignment_token($tok);
+ my ( $raw_tok, $lev, $tag_uu, $tok_count_uu ) =
+ decode_alignment_token($tok);
if ( $raw_tok eq '?' ) {
$depth_question = $lev;
# Note that this padding will remain even if the terminal value goes
# out on a separate line. This does not seem to look to bad, so no
# mechanism has been included to undo it.
- my $field1 = shift @fields;
+ my $field1_uu = shift @fields;
my $field_length1 = shift @field_lengths;
my $len_colon = length($colon);
unshift @fields, ( $colon, $pad . $therest );
# look for excessively long lines
my $max_excess = 0;
foreach my $item ( @{$rgroup_lines} ) {
- my ( $str, $str_len ) = @{$item};
+ my ( $str_uu, $str_len ) = @{$item};
my $excess =
$str_len + $leading_space_count - $group_maximum_line_length;
if ( $excess > $max_excess ) {
#------------------------------------------------------------------------
# STEP 1: Remove most unmatched tokens. They block good alignments.
- my ( $max_lev_diff, $saw_side_comment, $saw_signed_number ) =
+ my ( $max_lev_diff_uu, $saw_side_comment, $saw_signed_number ) =
delete_unmatched_tokens( $rgroup_lines, $group_level );
# STEP 2: Sweep top to bottom, forming subgroups of lines with exactly
}
my $j_terminal_match = $new_line->{'j_terminal_match'};
- my ( $jbeg, $jend ) = get_rgroup_jrange();
+ my ( $jbeg, $jend_uu ) = get_rgroup_jrange();
if ( !defined($jbeg) ) {
# safety check, shouldn't happen
my $var = pop(@todo);
$ng_beg = $var->[1];
}
- my ( $raw_tok, $lev, $tag, $tok_count ) = decode_alignment_token($tok);
+ my ( $raw_tok, $lev, $tag_uu, $tok_count_uu ) =
+ decode_alignment_token($tok);
push @todo, [ $i, $ng_beg, $ng_end, $raw_tok, $lev ];
}
return if ( !defined($ngb) || $nge <= $ngb );
foreach my $ng ( $ngb .. $nge ) {
- my ( $jbeg, $jend ) = @{ $rgroups->[$ng] };
+ my ( $jbeg, $jend_uu ) = @{ $rgroups->[$ng] };
my $line = $rlines->[$jbeg];
my $col = $line->get_column($itok);
my $move = $col_want - $col;
foreach my $i ( 0 .. $imax ) {
my $tok = $rtokens->[$i];
next if ( $tok eq '#' ); # shouldn't happen
- my ( $iii, $il, $ir, $raw_tok, $lev, $tag, $tok_count ) =
- @{ $rhash->{$tok} };
+ my ( $iii_uu, $il, $ir, $raw_tok, $lev, $tag_uu,
+ $tok_count )
+ = @{ $rhash->{$tok} };
#------------------------------------------------------
# Here is the basic RULE: remove an unmatched alignment
my $group_level = $rcall_hash->{group_level};
my $tok = $rcall_hash->{tok};
- my $tok_m = $rcall_hash->{tok_m};
- my $pat = $rcall_hash->{pat};
- my $pat_m = $rcall_hash->{pat_m};
- my $pad = $rcall_hash->{pad};
+## my $tok_m = $rcall_hash->{tok_m};
+ my $pat = $rcall_hash->{pat};
+ my $pat_m = $rcall_hash->{pat_m};
+ my $pad = $rcall_hash->{pad};
# helper routine for sub match_line_pairs to decide if patterns in two
# lines match well enough..Given
use constant EXPLAIN_COMPARE_PATTERNS => 0;
- my ( $alignment_token, $lev, $tag, $tok_count ) =
+ my ( $alignment_token, $lev, $tag_uu, $tok_count_uu ) =
decode_alignment_token($tok);
# We have to be very careful about aligning commas
$i++;
last if ( $i > $imax );
last if ( $tok eq '#' );
- my ( $raw_tok, $lev, $tag, $tok_count ) =
+ my ( $raw_tok_uu, $lev, $tag_uu, $tok_count_uu ) =
@{ $all_token_info[$jj]->[$i] };
last if ( $tok eq '#' );
foreach my $tok ( @{$rtokens} ) {
$itok++;
last if ( $itok > $imax );
- my ( $raw_tok, $lev, $tag, $tok_count ) =
+ my ( $raw_tok, $lev, $tag_uu, $tok_count_uu ) =
@{ $all_token_info[$jj]->[$itok] };
last if ( $raw_tok eq '#' );
foreach my $lev_test (@levs) {
my $jm = $jp - 1;
# Pull out needed values for the next line
- my ( $lev_min, $lev_max, $rtoken_patterns, $rlevs, $rtoken_indexes,
- $is_monotonic, $imax_true, $imax )
+ my ( $lev_min_uu, $lev_max_uu, $rtoken_patterns, $rlevs,
+ $rtoken_indexes, $is_monotonic_uu, $imax_true_uu, $imax_uu )
= @{ $rline_values->[$jp] };
# Transfer levels and patterns for this line to the working arrays.
last if ( !@todo_list );
my @todo_next;
foreach my $np (@todo_list) {
- my ( $jbeg_p, $jend_p, $np_p, $lev_p, $pat_p, $nc_beg_p, $nc_end_p,
- $rindexes_p )
+ my ( $jbeg_p, $jend_p, $np_p_uu, $lev_p, $pat_p_uu, $nc_beg_p,
+ $nc_end_p, $rindexes_p_uu )
= @{ $match_tree[$depth]->[$np] };
my $nlines_p = $jend_p - $jbeg_p + 1;
# loop to keep or delete each child node
foreach my $nc ( $nc_beg_p .. $nc_end_p ) {
- my ( $jbeg_c, $jend_c, $np_c, $lev_c, $pat_c, $nc_beg_c,
- $nc_end_c )
+ my ( $jbeg_c, $jend_c, $np_c_uu, $lev_c_uu, $pat_c_uu,
+ $nc_beg_c_uu, $nc_end_c_uu )
= @{ $match_tree[ $depth + 1 ]->[$nc] };
my $nlines_c = $jend_c - $jbeg_c + 1;
my $is_monotonic = $rline_values->[$jbeg_c]->[5];
my $imax = @{$rtokens} - 2;
foreach my $i ( 0 .. $imax ) {
my $tok = $rtokens->[$i];
- my ( $raw_tok, $lev, $tag, $tok_count ) =
+ my ( $raw_tok_uu, $lev, $tag_uu, $tok_count_uu ) =
decode_alignment_token($tok);
if ( $lev > $level_keep ) {
push @idel, $i;
return ( $is_marginal, $imax_align );
}
- my $jmax_0 = $line_0->{'jmax'};
- my $jmax_1 = $line_1->{'jmax'};
- my $rtokens_1 = $line_1->{'rtokens'};
- my $rtokens_0 = $line_0->{'rtokens'};
+ my $jmax_0 = $line_0->{'jmax'};
+ my $jmax_1 = $line_1->{'jmax'};
+ my $rtokens_1 = $line_1->{'rtokens'};
+## my $rtokens_0 = $line_0->{'rtokens'};
my $rfield_lengths_0 = $line_0->{'rfield_lengths'};
my $rfield_lengths_1 = $line_1->{'rfield_lengths'};
my $rpatterns_0 = $line_0->{'rpatterns'};
my $j0_max_pad = 0;
foreach my $j ( 0 .. $jmax_1 - 2 ) {
- my ( $raw_tok, $lev, $tag, $tok_count ) =
+ my ( $raw_tok, $lev, $tag_uu, $tok_count_uu ) =
decode_alignment_token( $rtokens_1->[$j] );
if ( $raw_tok && $lev == $group_level ) {
if ( !$raw_tokb ) { $raw_tokb = $raw_tok }
# Loop over the groups with side comments
my $column_limit;
foreach my $ngr (@todo) {
- my ( $jbeg, $jend ) = @{ $rgroups->[$ngr] };
+ my ( $jbeg, $jend_uu ) = @{ $rgroups->[$ngr] };
# Note that since all lines in a group have common alignments, we
# just have to work on one of the lines (the first line).
my ( $min_unsigned_length, $max_unsigned_length, $median_unsigned_length )
= min_max_median( \@len_unsigned );
- my ( $min_signed_length, $max_signed_length, $median_signed_length ) =
+ my ( $min_signed_length_uu, $max_signed_length, $median_signed_length ) =
min_max_median( \@len_signed );
# Skip padding if no signed numbers exceed unsigned numbers in length
my $outdent_long_lines = $rinput->{outdent_long_lines};
my $rvertical_tightness_flags = $rinput->{rvertical_tightness_flags};
my $level = $rinput->{level};
- my $level_end = $rinput->{level_end};
- my $Kend = $rinput->{Kend};
- my $maximum_line_length = $rinput->{maximum_line_length};
+## my $level_end = $rinput->{level_end};
+ my $Kend = $rinput->{Kend};
+ my $maximum_line_length = $rinput->{maximum_line_length};
# Useful -gcs test cases for wide characters are
# perl527/(method.t.2, reg_mesg.t, mime-header.t)
--warn-missing-else
# warn if certain of the 'unusual' variables are seen
---warn-variable-types='s r p c'
+--warn-variable-types='*' ##'s r p c'
+--warn-variable-exclusion-list='$self $class *_uu'
# warn if call arg counts differ from sub definitions
# (requires version > 20240202.04)
projects / perltidy.git / commitdiff