sub find_input_line_ending {
# Peek at a file and return first line ending character.
- # Quietly return undef in case of any trouble.
+ # Return undefined value in case of any trouble.
my ($input_file) = @_;
my $ending;
my @parts = @_;
- #BEGIN { eval "require File::Spec"; $missing_file_spec = $@; }
BEGIN {
eval { require File::Spec };
$missing_file_spec = $@;
# Perl 5.004 systems may not have File::Spec so we'll make
# a simple try. We assume File::Basename is available.
- # return undef if not successful.
+ # return if not successful.
my $name = pop @parts;
my $path = join '/', @parts;
my $test_file = $path . $name;
}
}
-# This is the original coding, which worked,
-# but I've rewritten it (above) to keep Perl-Critic from complaining
-# Keep for awhile.
-
-=pod
-sub process_command_line {
-
- my (
- $perltidyrc_stream, $is_Windows, $Windows_type,
- $rpending_complaint, $dump_options_type
- ) = @_;
-
- my $use_cache = !defined($perltidyrc_stream) && !$dump_options_type;
- if ($use_cache) {
- my $cache_key = join( chr(28), @ARGV );
- if ( my $result = $process_command_line_cache{$cache_key} ) {
- my ( $argv, @retvals ) = @{$result};
- @ARGV = @{$argv};
- return @retvals;
- }
- else {
- my @retvals = _process_command_line(@_);
- $process_command_line_cache{$cache_key} = [ \@ARGV, @retvals ]
- if $retvals[0]->{'memoize'};
- return @retvals;
- }
- }
- else {
- return _process_command_line(@_);
- }
-}
-=cut
-
# (note the underscore here)
sub _process_command_line {
$rOpts->{'check-syntax'} = 0;
}
+ ###########################################################################
# Added Dec 2017: Deactivating check-syntax for all systems for safety
# because unexpected results can occur when code in BEGIN blocks is
# executed. This flag was included to help check for perltidy mistakes,
# and may still be useful for debugging. To activate for testing comment
- # out the next three lines.
+ # out the next three lines. Also fix sub 'do_check_syntax' in this file.
+ ###########################################################################
else {
$rOpts->{'check-syntax'} = 0;
}
# the perl version number will be helpful for diagnosing the problem
$logger_object->write_logfile_entry( $^V . "\n" );
- ##qx/perl -v $error_redirection/ . "\n" );
}
}
else {
# let logger see all non-blank lines of code
my $output_line_number = get_output_line_number();
- ##$vertical_aligner_object->get_output_line_number();
black_box( $line_of_tokens, $output_line_number );
}
print STDERR "ntokens=$nvars\n";
print STDERR "K\t_TOKEN_\t_TYPE_\n";
my $K = 0;
+
foreach my $item ( @{$rLL} ) {
print STDERR "$K\t$item->[_TOKEN_]\t$item->[_TYPE_]\n";
$K++;
my $length_to_opening_seqno = sub {
my ($seqno) = @_;
- my $KK = $K_opening_container->{$seqno};
- my $lentot = $KK <= 0 ? 0 : $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_];
+ my $KK = $K_opening_container->{$seqno};
+ my $lentot = $KK <= 0 ? 0 : $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_];
return $lentot;
};
my $length_to_closing_seqno = sub {
my ($seqno) = @_;
- my $KK = $K_closing_container->{$seqno};
- my $lentot = $KK <= 0 ? 0 : $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_];
+ my $KK = $K_closing_container->{$seqno};
+ my $lentot = $KK <= 0 ? 0 : $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_];
return $lentot;
};
my $length_to_opening_seqno = sub {
my ($seqno) = @_;
- my $KK = $K_opening_container->{$seqno};
- my $lentot = $KK <= 0 ? 0 : $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_];
+ my $KK = $K_opening_container->{$seqno};
+ my $lentot = $KK <= 0 ? 0 : $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_];
return $lentot;
};
my $length_to_closing_seqno = sub {
my ($seqno) = @_;
- my $KK = $K_closing_container->{$seqno};
- my $lentot = $KK <= 0 ? 0 : $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_];
- ##my $lentot = $rLL->[$KK]->[_CUMULATIVE_LENGTH_];
+ my $KK = $K_closing_container->{$seqno};
+ my $lentot = $KK <= 0 ? 0 : $rLL->[ $KK - 1 ]->[_CUMULATIVE_LENGTH_];
return $lentot;
};
# No longer doing this: also write a line which is entirely a 'qw' list
# to allow stacking of opening and closing tokens. Note that interior
# qw lines will still go out at the end of this routine.
- ##if ( $rOpts->{'indent-only'} ) {
if ( $CODE_type eq 'IO' ) {
$self->flush();
my $line = $input_line;
$want_blank =
$rOpts->{'blanks-before-blocks'}
&& $lc >= $rOpts->{'long-block-line-count'}
- ##&& $file_writer_object->get_consecutive_nonblank_lines() >=
&& consecutive_nonblank_lines() >=
$rOpts->{'long-block-line-count'}
&& (
# These are used below to prevent unwanted cross-line alignments.
# Unbalanced containers already avoid aligning across
# container boundaries.
- ##if ( $tokens_to_go[$i] eq '(' ) {
- my $tok=$tokens_to_go[$i];
- if ( $tok =~ /^[\(\{\[]/ ) { #'(' ) {
+ my $tok = $tokens_to_go[$i];
+ if ( $tok =~ /^[\(\{\[]/ ) { #'(' ) {
# if container is balanced on this line...
my $i_mate = $mate_index_to_go[$i];
# within this container, and it helps avoid undesirable
# alignments of different types of containers.
- # Containers beginning with { and [ are given those names
- # for uniqueness. That way commas in different containers
- # will not match. Here is an example of what this prevents:
- # a => [ 1, 2, 3 ],
- # b => { b1 => 4, b2 => 5 },
- # Here is another example of what avoid by labeling the commas properly:
- # is_deeply( [ $a, $a ], [ $b, $c ] );
- # is_deeply( { foo => $a, bar => $a }, { foo => $b, bar => $c } );
- # is_deeply( [ \$a, \$a ], [ \$b, \$c ] );
+ # Containers beginning with { and [ are given those names
+ # for uniqueness. That way commas in different containers
+ # will not match. Here is an example of what this prevents:
+ # a => [ 1, 2, 3 ],
+ # b => { b1 => 4, b2 => 5 },
+ # Here is another example of what we avoid by labeling the
+ # commas properly:
+ # is_d( [ $a, $a ], [ $b, $c ] );
+ # is_d( { foo => $a, bar => $a }, { foo => $b, bar => $c } );
+ # is_d( [ \$a, \$a ], [ \$b, \$c ] );
my $name = $tok;
if ( $tok eq '(' ) {
}
}
##elsif ( $tokens_to_go[$i] eq ')' ) {
- elsif ( $tokens_to_go[$i] =~ /^[\)\}\]]/ ) {
+ elsif ( $tokens_to_go[$i] =~ /^[\)\}\]]/ ) {
$depth-- if $depth > 0;
}
#--------------------------------------------------------
# patch for =~ operator. We only align this if it
# is the first operator in a line, and the line is a simple
- # statement. Aligning them within a statement
+ # statement. Aligning them within a statement
# interferes could interfere with other good alignments.
#--------------------------------------------------------
if ( $alignment_type eq '=~' ) {
my $im3 = $i_opening_paren - 3;
my $typem1 = $types_to_go[$im1];
my $typem2 = $im2 >= 0 ? $types_to_go[$im2] : 'b';
+
if ( $typem1 eq ',' || ( $typem1 eq 'b' && $typem2 eq ',' ) ) {
$i_opening_minus = $i_opening_paren;
}
my $total_variation_1 = 0;
my $total_variation_2 = 0;
my @total_variation_2 = ( 0, 0 );
+
foreach my $j ( 0 .. $item_count - 1 ) {
$is_odd = 1 - $is_odd;
# variables used to track depths of various containers
# and report nesting errors
- $paren_depth = 0;
- $brace_depth = 0;
- $square_bracket_depth = 0;
- @current_depth[ 0 .. $#closing_brace_names ] =
- (0) x scalar @closing_brace_names;
- $total_depth = 0;
- @total_depth = ();
- @nesting_sequence_number[ 0 .. $#closing_brace_names ] =
- ( 0 .. $#closing_brace_names );
+ $paren_depth = 0;
+ $brace_depth = 0;
+ $square_bracket_depth = 0;
+ @current_depth = (0) x scalar @closing_brace_names;
+ $total_depth = 0;
+ @total_depth = ();
+ @nesting_sequence_number = ( 0 .. @closing_brace_names - 1 );
@current_sequence_number = ();
$paren_type[$paren_depth] = '';
$paren_semicolon_count[$paren_depth] = 0;
# find the closing quote; don't worry about escapes
my $quote_mark = $pre_types[$j];
- foreach my $k ( $j + 1 .. $#pre_types - 1 ) {
+ foreach my $k ( $j + 1 .. @pre_types - 2 ) {
if ( $pre_types[$k] eq $quote_mark ) {
$j = $k + 1;
my $next = $pre_types[$j];
$starting_line_of_current_depth[$aa][ $current_depth[$aa] ] =
[ $input_line_number, $input_line, $pos ];
- for my $bb ( 0 .. $#closing_brace_names ) {
+ for my $bb ( 0 .. @closing_brace_names - 1 ) {
next if ( $bb == $aa );
$depth_array[$aa][$bb][ $current_depth[$aa] ] = $current_depth[$bb];
}
$statement_type = $nested_statement_type[$aa][ $current_depth[$aa] ];
# check that any brace types $bb contained within are balanced
- for my $bb ( 0 .. $#closing_brace_names ) {
+ for my $bb ( 0 .. @closing_brace_names - 1 ) {
next if ( $bb == $aa );
unless ( $depth_array[$aa][$bb][ $current_depth[$aa] ] ==
# USES GLOBAL VARIABLES: @current_depth, @starting_line_of_current_depth
- for my $aa ( 0 .. $#closing_brace_names ) {
+ for my $aa ( 0 .. @closing_brace_names - 1 ) {
if ( $current_depth[$aa] ) {
my $rsl =
# <$LATEX2HTMLVERSIONS${dd}html[1-9].[0-9].pl>
#
# Here are some examples of lines which do not have angle operators:
- # return undef unless $self->[2]++ < $#{$self->[1]};
+ # return unless $self->[2]++ < $#{$self->[1]};
# < 2 || @$t >
#
# the following line from dlister.pl caused trouble:
}
}
else { # found ending quote
- ##my $j;
$found_target = 1;
my $tokj;
# number of fields is $jmax
# number of tokens between fields is $jmax-1
- my $jmax = @{$rfields}-1;
+ my $jmax = @{$rfields} - 1;
my $leading_space_count = get_spaces($indentation);
my $nlines = @group_lines;
print STDOUT
"APPEND0: entering lines=$nlines new #fields= $jmax, leading_count=$leading_space_count last_cmt=$last_comment_column force=$is_forced_break, level_jump=$level_jump, level=$level, group_level=$group_level, level_jump=$level_jump\n";
- };
+ };
# Validate cached line if necessary: If we can produce a container
# with just 2 lines total by combining an existing cached opening
# programming check: (shouldn't happen)
# an error here implies an incorrect call was made
- if ( @{$rfields} && ( @{$rtokens} != ( @{$rfields}- 1 ) ) ) {
- my $nt=@{$rtokens};
- my $nf=@{$rfields};
+ if ( @{$rfields} && ( @{$rtokens} != ( @{$rfields} - 1 ) ) ) {
+ my $nt = @{$rtokens};
+ my $nf = @{$rfields};
warning(
"Program bug in Perl::Tidy::VerticalAligner - number of tokens = $nt should be one less than number of fields: $nf)\n"
);
}
# Force break after jump to lower level
- if ( $level_jump < 0 ) {
+ if ( $level_jump < 0 ) {
my_flush();
}
my $nlines = @group_lines;
print STDOUT
"APPEND0: my_flush called from $a $b $c lines=$nlines, type=$group_type \n";
- };
+ };
# handle a group of COMMENT lines
if ( $group_type eq 'COMMENT' ) { my_flush_comment() }
add_to_group($new_line);
# flush if no side comment and no matching token. This prevents
- # this line from pushing sidecoments out to the right.
+ # this line from pushing sidecoments out to the right.
if ( no_matching_tokens($new_line) ) { my_flush_code() }
next;
}
# -------------------------------------------------------------
if ( $new_line->get_is_hanging_side_comment() ) {
- join_hanging_comment( $new_line, $base_line )
+ join_hanging_comment( $new_line, $base_line );
}
# flush if no side comment and no matching token. This prevents
my $kmax = @{$ridel} - 1;
my $k = 0;
my $jdel_next = $ridel->[$k];
+
# FIXME:
if ( $jdel_next < 0 ) { print STDERR "bad jdel_next=$jdel_next\n"; return }
my $pattern = $rpatterns_old->[0];
my $jdel_last = $jdel_next;
$jdel_next = $ridel->[$k];
if ( $jdel_next < $jdel_last ) {
- # FIXME:
+
+ # FIXME:
print STDERR "bad jdel_next=$jdel_next\n";
return;
}
my $rhash = {};
my $rtokens = $line->get_rtokens();
my $i = 0;
- my $i_eq;
+ my $i_eq;
foreach my $tok ( @{$rtokens} ) {
$rhash->{$tok} = [ $i, undef, undef ];
- # remember the first equals at line level
+ # remember the first equals at line level
if ( !defined($i_eq) && $tok =~ /^=(\d+)/ ) {
my $lev = $1;
if ( $lev eq $group_level ) { $i_eq = $i }
my $i = 0;
my $nl = 0;
my $nr = 0;
- my $i_eq = $i_equals[$jj];
+ my $i_eq = $i_equals[$jj];
my @idel;
my $imax = @{$rtokens} - 2;
+
for ( my $i = 0 ; $i <= $imax ; $i++ ) {
my $tok = $rtokens->[$i];
next if ( $tok eq '#' ); # shouldn't happen
projects / perltidy.git / commitdiff