my $terminal_block_type = $block_type_to_go[$i_terminal];
my $is_outdented_line = 0;
+ my $type_beg = $types_to_go[$ibeg];
+ my $token_beg = $tokens_to_go[$ibeg];
+ my $K_beg = $K_to_go[$ibeg];
+ my $ibeg_weld_fix = $ibeg;
+ my $seqno_beg = $type_sequence_to_go[$ibeg];
+ my $is_bli_beg = $seqno_beg ? $ris_bli_container->{$seqno_beg} : 0;
+
+ my $is_closing_qw = ( $type_beg eq 'q' && $iend > $ibeg );
+
my $is_semicolon_terminated = $terminal_type eq ';'
- && $nesting_depth_to_go[$iend] < $nesting_depth_to_go[$ibeg];
+ && ( $nesting_depth_to_go[$iend] < $nesting_depth_to_go[$ibeg]
+ || $is_closing_qw );
# NOTE: A future improvement would be to make it semicolon terminated
# even if it does not have a semicolon but is followed by a closing
$is_leading, $opening_exists
);
- my $type_beg = $types_to_go[$ibeg];
- my $token_beg = $tokens_to_go[$ibeg];
- my $K_beg = $K_to_go[$ibeg];
- my $ibeg_weld_fix = $ibeg;
- my $seqno_beg = $type_sequence_to_go[$ibeg];
- my $is_bli_beg = $seqno_beg ? $ris_bli_container->{$seqno_beg} : 0;
-
# Update the $is_bli flag as we go. It is initially 1.
# We note seeing a leading opening brace by setting it to 2.
# If we get to the closing brace without seeing the opening then we
# For -lp formatting se use $ibeg_weld_fix to get around the problem
# that with -lp type formatting the opening and closing tokens to not
# have sequence numbers.
- if ( $type_beg eq 'q'
- && ( $is_closing_token{$token_beg} || $token_beg eq '>' ) )
- {
+ if ($is_closing_qw) {
my $K_next_nonblank = $self->K_next_code($K_beg);
if ( defined($K_next_nonblank) ) {
my $type_sequence = $rLL->[$K_next_nonblank]->[_TYPE_SEQUENCE_];
}
# if we are at a closing token of some type..
- if ( $is_closing_type{$type_beg} ) {
+ if ( $is_closing_type{$type_beg} || $is_closing_qw ) {
# get the indentation of the line containing the corresponding
# opening token
# need to remove some spaces to get a valid hash key.
my $tok = $tokens_to_go[$ibeg];
my $cti = $closing_token_indentation{$tok};
+
+ # Fix the value of 'cti' for an isloated non-welded closing qw
+ # delimiter.
+ if ( $is_closing_qw && $ibeg_weld_fix == $ibeg ) {
+
+ # A quote delimiter which is not a container will not have
+ # a cti value defined. In this case use the style of a
+ # paren. For example
+ # my @words = (
+ # qw/
+ # far
+ # farfar
+ # farfars far
+ # /,
+ # );
+ if ( !defined($cti) && length($tok) == 1 ) {
+ $cti = $closing_token_indentation{')'};
+ }
+
+ # A non-welded closing qw cannot currently use -cti=1
+ # because that option requires a sequence number to find
+ # the opening indentation, and qw quote delimiters are not
+ # sequenced items.
+ if ( defined($cti) && $cti == 1 ) { $cti = 0 }
+ }
+
if ( !defined($cti) ) {
# $cti may not be defined for several reasons.
=over 4
+=item B<Fix git #51, closing quote pattern delimiters not following -cti flag settings>
+
+Closing pattern delimiter tokens of qw quotes were not following the -cti flag
+settings for containers in all cases, as would be expected, in particular when
+followed by a comma. For example, the closing qw paren below was indented with
+continuation indentation but would not have that extra indentation if it
+followed the default -cpi setting for a paren:
+
+ # OLD:
+ @EXPORT = (
+ qw(
+ i Re Im rho theta arg
+ sqrt log ln
+ log10 logn cbrt root
+ cplx cplxe
+ ),
+ @trig
+ );
+
+ # NEW
+ @EXPORT = (
+ qw(
+ i Re Im rho theta arg
+ sqrt log ln
+ log10 logn cbrt root
+ cplx cplxe
+ ),
+ @trig
+ );
+
+This update makes closing qw quote terminators follow the settings for their
+corresponding container tokens as closely as possible. In addition, for
+closing quote tokens which are not containers, the setting for a closing paren
+will now be followed. For example
+
+ @EXPORT = (
+ qw#
+ i Re Im rho theta arg
+ sqrt log ln
+ log10 logn cbrt root
+ cplx cplxe
+ #,
+ @trig
+ );
+
+This update was added 18 Dec 2020.
+
+=item B<Update manual pages regarding issue git #50>
+
+Additional wording was added to the man pages regarding situations in which
+perltidy does not change whitespace. This update was added 17 Dec 2020.
+
=item B<Rewrote sub check_match>
Moved inner part of sub check_match into sub match_line_pair in order to
make info available earlier. This gave some minor alignment improvements.
+This was done 16 Dec 2020.
# OLD:
@tests = (
set_interpolation_points
table_row_interpolation
two_point_interpolation
- ); # with -kgb, break around isolated 'local' below
+); # with -kgb, break around isolated 'local' below
use Text::Warp();
local ($delta2print) =
( defined $size ) ? int( $size / 50 ) : $defaultdelta2print;
set_interpolation_points
table_row_interpolation
two_point_interpolation
- ); # with -kgb, break around isolated 'local' below
+); # with -kgb, break around isolated 'local' below
use Text::Warp();
local ($delta2print) =
sub Numerically { $a <=> $b }; # trapped semicolon
@: = qw;2c72656b636168
2020202020
- ;;
+;;
__;
sub Numerically { $a <=> $b }; # trapped semicolon
@: = qw;2c72656b636168
2020202020
- ;;
+;;
__;
../snippets23.t wnxl.wnxl3
../snippets23.t wnxl.wnxl4
../snippets23.t align34.def
+../snippets23.t git47.def
+../snippets23.t git47.git47
../snippets3.t ce_wn1.ce_wn
../snippets3.t ce_wn1.def
../snippets3.t colin.colin
../snippets9.t rt98902.def
../snippets9.t rt98902.rt98902
../snippets9.t rt99961.def
-../snippets23.t git47.def
-../snippets23.t git47.git47
EOM
}
-my $nf_beg = 1;
+my $nf_beg = 1;
my $np_beg = 1;
if ( @ARGV > 1 ) {
print STDERR "Too many args\n";
die $usage;
}
-elsif ($ARGV[0]) {
- my $arg=$ARGV[0];
+elsif ( $ARGV[0] ) {
+ my $arg = $ARGV[0];
if ( $arg && $arg =~ /^(\d+)\.(\d+)$/ ) {
- $nf_beg = $1;
+ $nf_beg = $1;
$np_beg = $2;
- print STDERR "\nRestarting with arg $arg\n"
+ print STDERR "\nRestarting with arg $arg\n";
}
else {
print STDERR "First arg '$arg' not of form m.n\n";
$binfile = "perl $perltidy";
}
-
-
$FILES_file = "FILES.txt" unless ($FILES_file);
$PROFILES_file = "PROFILES.txt" unless ($PROFILES_file);
$chain_mode = 0 unless defined($chain_mode);
my $rfiles = read_list($FILES_file);
my $rprofiles = read_list($PROFILES_file);
-my @files = @{$rfiles};
+my @files = @{$rfiles};
my $nfiles = @files;
print STDOUT "got $nfiles files\n";
if ( !@files ) { die "No files found\n" }
push @profiles, $fname;
}
-my $rsummary = [];
+my $rsummary = [];
my @problems;
my $stop_file = 'stop.now';
my $file_count = 0;
my $case = 0;
MAIN_LOOP:
-for (my $nf=$nf_beg; $nf<=$nf_end; $nf++) {
- my $file=$files[$nf-1];
+for ( my $nf = $nf_beg ; $nf <= $nf_end ; $nf++ ) {
+ my $file = $files[ $nf - 1 ];
# remove any previously saved files
if (@saved_for_deletion) {
}
next unless -e $file;
- $file_count=$nf;
+ $file_count = $nf;
my $ifile = $file;
my $ifile_original = $ifile;
my $ifile_size = -s $ifile;
my $starting_syntax_ok = 1;
# Inner loop over profiles for a given file
- for (my $np=$np_beg; $np<=$np_end; $np++) {
- my $profile=$profiles[$np-1];
+ for ( my $np = $np_beg ; $np <= $np_end ; $np++ ) {
+ my $profile = $profiles[ $np - 1 ];
$case = $np;
my $error_count_this_case = 0;
my $ofile = "ofile.$ext";
my $chkfile = "chkfile.$ext";
- print STDERR "\n-----\nRun '$nf.$np' : profile='$profile', ifile='$ifile'\n";
+ print STDERR
+ "\n-----\nRun '$nf.$np' : profile='$profile', ifile='$ifile'\n";
my $cmd = "$binfile <$ifile >$ofile -pro=$profile";
print STDERR "$cmd\n";
}
}
- # Check for unexpectedly very small file size
- elsif ( $case > 3 && $ofile_size < 0.6 * $ofile_size_min_expected )
+ # Check for an unexpectedly very small file size...
+ # NOTE: file sizes can often be unexpectly small when operating on
+ # random text. For example, if a random line begins with an '='
+ # then when a --delete-pod parameter is set, everything from there
+ # on gets deleted.
+ # But we still want to catch zero size files, since they might
+ # indicate a code crash. So I have lowered the fraction in this
+ # test to a small value.
+ elsif ( $case > 3 && $ofile_size < 0.1 * $ofile_size_min_expected )
{
print STDERR
-"**ERROR for ofile=$ofile: size = $ofile_size < $ofile_size_min_expected = min expected\n";
+"**ERROR for ofile=$ofile: size = $ofile_size << $ofile_size_min_expected = min expected\n";
push @size_errors, $ofile;
$error_count_this_file++;
$error_count_this_case++;
# Set input file for next run
$ifile = $ifile_original;
if ( $case >= 4 && $chain_mode && !$err ) {
- # 'Chaining' means the next run formats the output of the previous
- # run instead of formatting the original file.
+
+ # 'Chaining' means the next run formats the output of the previous
+ # run instead of formatting the original file.
# 0 = no chaining
# 1 = always chain unless error
# 2 = random chaining
)
{
push @problems, $file_count;
- } ## end inner loop over profiles
-} ## end outer loop over files
+ } ## end inner loop over profiles
+} ## end outer loop over files
if (@saved_for_deletion) {
foreach (@saved_for_deletion) {
write_runme();
# Write a restart file
-my ($nf, $np);
+my ( $nf, $np );
if ( $case < $np_end ) {
$nf = $file_count;
$np = $case + 1;
- write_GO($nf, $np);
+ write_GO( $nf, $np );
}
elsif ( $file_count < $nf_end ) {
$nf = $file_count + 1;
$np = 1;
- write_GO($nf, $np);
+ write_GO( $nf, $np );
}
print STDERR <<EOM;
sub write_GO {
- my ($nf, $np) = @_;
+ my ( $nf, $np ) = @_;
my $runme = "GO.sh";
- unlink $runme if (-e $runme);
+ unlink $runme if ( -e $runme );
my $fh;
open( $fh, '>', $runme ) || die "cannot open $runme: $!\n";
$fh->print(<<EOM);
set_interpolation_points
table_row_interpolation
two_point_interpolation
- ); # with -kgb, break around isolated 'local' below
+); # with -kgb, break around isolated 'local' below
use Text::Warp();
local ($delta2print) =
( defined $size ) ? int( $size / 50 ) : $defaultdelta2print;
set_interpolation_points
table_row_interpolation
two_point_interpolation
- ); # with -kgb, break around isolated 'local' below
+); # with -kgb, break around isolated 'local' below
use Text::Warp();
local ($delta2print) =
sub Numerically { $a <=> $b }; # trapped semicolon
@: = qw;2c72656b636168
2020202020
- ;;
+;;
__;
#14...........
},
sub Numerically { $a <=> $b }; # trapped semicolon
@: = qw;2c72656b636168
2020202020
- ;;
+;;
__;
#15...........
},
projects / perltidy.git / commitdiff