From: Steve Hancock Date: Fri, 18 Dec 2020 15:03:42 +0000 (-0800) Subject: fix issue git #51, qw delimiters not following -cti flags X-Git-Tag: 20210111~35 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=54a12a4dc4bf69adde918a5365caae92190c371a;p=perltidy.git fix issue git #51, qw delimiters not following -cti flags --- diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index 997ea8d0..4e178301 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -18648,8 +18648,18 @@ sub make_paren_name { 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 @@ -18697,13 +18707,6 @@ sub make_paren_name { $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 @@ -18728,9 +18731,7 @@ sub make_paren_name { # 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_]; @@ -18747,7 +18748,7 @@ sub make_paren_name { } # 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 @@ -18906,6 +18907,32 @@ sub make_paren_name { # 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. diff --git a/local-docs/BugLog.pod b/local-docs/BugLog.pod index 05b75855..831f31ed 100644 --- a/local-docs/BugLog.pod +++ b/local-docs/BugLog.pod @@ -2,10 +2,63 @@ =over 4 +=item B + +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 + +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 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 = ( diff --git a/t/snippets/expect/kgb3.def b/t/snippets/expect/kgb3.def index 5cdbe88c..6a75e95f 100644 --- a/t/snippets/expect/kgb3.def +++ b/t/snippets/expect/kgb3.def @@ -9,7 +9,7 @@ use Blast::IPS::MathUtils qw( 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; diff --git a/t/snippets/expect/kgb3.kgb b/t/snippets/expect/kgb3.kgb index 159b0c26..4ec7d536 100644 --- a/t/snippets/expect/kgb3.kgb +++ b/t/snippets/expect/kgb3.kgb @@ -10,7 +10,7 @@ use Blast::IPS::MathUtils qw( 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) = diff --git a/t/snippets/expect/ndsm1.def b/t/snippets/expect/ndsm1.def index c36b944f..c2b812f3 100644 --- a/t/snippets/expect/ndsm1.def +++ b/t/snippets/expect/ndsm1.def @@ -4,5 +4,5 @@ sub numerically { $a <=> $b } sub Numerically { $a <=> $b }; # trapped semicolon @: = qw;2c72656b636168 2020202020 - ;; +;; __; diff --git a/t/snippets/expect/ndsm1.ndsm b/t/snippets/expect/ndsm1.ndsm index d5e53dd9..e79a123f 100644 --- a/t/snippets/expect/ndsm1.ndsm +++ b/t/snippets/expect/ndsm1.ndsm @@ -12,5 +12,5 @@ sub numerically { $a <=> $b }; sub Numerically { $a <=> $b }; # trapped semicolon @: = qw;2c72656b636168 2020202020 - ;; +;; __; diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt index eb1f161d..ac76c9c0 100644 --- a/t/snippets/packing_list.txt +++ b/t/snippets/packing_list.txt @@ -305,6 +305,8 @@ ../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 @@ -445,5 +447,3 @@ ../snippets9.t rt98902.def ../snippets9.t rt98902.rt98902 ../snippets9.t rt99961.def -../snippets23.t git47.def -../snippets23.t git47.git47 diff --git a/t/snippets/perltidy_random_run.pl b/t/snippets/perltidy_random_run.pl index 8036b9c5..455dd073 100755 --- a/t/snippets/perltidy_random_run.pl +++ b/t/snippets/perltidy_random_run.pl @@ -48,18 +48,18 @@ Please run 'perltidy_random_setup.pl' first 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"; @@ -81,8 +81,6 @@ if ($perltidy) { $binfile = "perl $perltidy"; } - - $FILES_file = "FILES.txt" unless ($FILES_file); $PROFILES_file = "PROFILES.txt" unless ($PROFILES_file); $chain_mode = 0 unless defined($chain_mode); @@ -92,7 +90,7 @@ $delete_good_output = 1 unless defined($delete_good_output); 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" } @@ -113,7 +111,7 @@ if ( !@profiles ) { push @profiles, $fname; } -my $rsummary = []; +my $rsummary = []; my @problems; my $stop_file = 'stop.now'; @@ -141,8 +139,8 @@ EOM 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) { @@ -153,7 +151,7 @@ for (my $nf=$nf_beg; $nf<=$nf_end; $nf++) { } next unless -e $file; - $file_count=$nf; + $file_count = $nf; my $ifile = $file; my $ifile_original = $ifile; my $ifile_size = -s $ifile; @@ -177,8 +175,8 @@ for (my $nf=$nf_beg; $nf<=$nf_end; $nf++) { 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; @@ -189,7 +187,8 @@ for (my $nf=$nf_beg; $nf<=$nf_end; $nf++) { 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"; @@ -233,11 +232,18 @@ for (my $nf=$nf_beg; $nf<=$nf_end; $nf++) { } } - # 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++; @@ -344,8 +350,9 @@ for (my $nf=$nf_beg; $nf<=$nf_end; $nf++) { # 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 @@ -449,8 +456,8 @@ for (my $nf=$nf_beg; $nf<=$nf_end; $nf++) { ) { 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) { @@ -513,16 +520,16 @@ EOM 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 <', $runme ) || die "cannot open $runme: $!\n"; $fh->print(< $b } sub Numerically { $a <=> $b }; # trapped semicolon @: = qw;2c72656b636168 2020202020 - ;; +;; __; #14........... }, @@ -378,7 +378,7 @@ sub numerically { $a <=> $b }; sub Numerically { $a <=> $b }; # trapped semicolon @: = qw;2c72656b636168 2020202020 - ;; +;; __; #15........... },