From: Steve Hancock Date: Mon, 14 Sep 2020 17:16:23 +0000 (-0700) Subject: Allow line-ending '=>' to align vertically X-Git-Tag: 20200907.01~6 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=ea96739ce3de0a93d8fa7cd784d9de1cd2c72f78;p=perltidy.git Allow line-ending '=>' to align vertically --- diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index 0ebd4648..40c8c403 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -12652,7 +12652,7 @@ sub get_seqno { @is_not_vertical_alignment_token{@q} = (1) x scalar(@q); # these are the only types aligned at a line end - @q = qw(&& ||); + @q = qw(&& || =>); @is_terminal_alignment_type{@q} = (1) x scalar(@q); # these tokens only align at line level @@ -12801,7 +12801,7 @@ sub get_seqno { # moved far to the right where it is hard to see because # nothing follows it, and # (2) doing so may prevent other good alignments. - # Current exceptions are && and || + # Current exceptions are && and || and => if ( $i == $iend || $i >= $i_terminal ) { $alignment_type = "" unless ( $is_terminal_alignment_type{$type} ); @@ -16464,6 +16464,7 @@ sub set_nobreaks { # ...and preceded by a semicolon on the same line my $K_semicolon = $self->K_previous_nonblank($K_end); + next unless defined($K_semicolon); my $i_semicolon = $i_beg + ( $K_semicolon - $K_beg ); next if ( $i_semicolon <= $i_beg ); next unless ( $rLL->[$K_semicolon]->[_TYPE_] eq ';' ); diff --git a/lib/Perl/Tidy/VerticalAligner.pm b/lib/Perl/Tidy/VerticalAligner.pm index 17171fd9..550af874 100644 --- a/lib/Perl/Tidy/VerticalAligner.pm +++ b/lib/Perl/Tidy/VerticalAligner.pm @@ -3296,6 +3296,8 @@ sub Dump_tree_groups { my $saw_if_or; # if we saw an 'if' or 'or' at group level my $raw_tokb = ""; # first token seen at group level my $jfirst_bad; + my $line_ending_fat_comma; # is last token just a '=>' ? + for ( my $j = 0 ; $j < $jmax_1 - 1 ; $j++ ) { my ( $raw_tok, $lev, $tag, $tok_count ) = decode_alignment_token( $rtokens_1->[$j] ); @@ -3303,6 +3305,16 @@ sub Dump_tree_groups { if ( !$raw_tokb ) { $raw_tokb = $raw_tok } $saw_if_or ||= $is_if_or{$raw_tok}; } + + # Look for a line ending in a bare '=>' + # These make marginal matches with just two lines. + $line_ending_fat_comma = ( + $j == $jmax_1 - 2 + && $raw_tok eq '=>' + && ( $rfield_lengths_0->[ $j + 1 ] == 2 + || $rfield_lengths_1->[ $j + 1 ] == 2 ) + ); + my $pad = $rfield_lengths_1->[$j] - $rfield_lengths_0->[$j]; if ( $j == 0 ) { $pad += $line_1->get_leading_space_count() - @@ -3311,7 +3323,7 @@ sub Dump_tree_groups { if ( $pad < 0 ) { $pad = -$pad } if ( $pad > $max_pad ) { $max_pad = $pad } - if ( $is_good_alignment{$raw_tok} ) { + if ( $is_good_alignment{$raw_tok} && !$line_ending_fat_comma ) { $saw_good_alignment = 1; } else { @@ -3340,6 +3352,8 @@ sub Dump_tree_groups { } } + $is_marginal = 1 if ( $is_marginal == 0 && $line_ending_fat_comma ); + if ( !defined($jfirst_bad) ) { $jfirst_bad = $jmax_1 - 1; } # Turn off the "marginal match" flag in some cases... @@ -3433,7 +3447,7 @@ sub Dump_tree_groups { elsif ( $raw_tokb eq '=>' ) { # undo marginal flag if patterns match - $is_marginal = $pat0 ne $pat1; + $is_marginal = $pat0 ne $pat1 || $line_ending_fat_comma; } elsif ( $raw_tokb eq '=~' ) { diff --git a/local-docs/BugLog.pod b/local-docs/BugLog.pod index 5ed1b3d3..509ce4ab 100644 --- a/local-docs/BugLog.pod +++ b/local-docs/BugLog.pod @@ -5,13 +5,76 @@ found with the help of automated random testing. =over +=item B + +A change was made to allow a '=>' at the end of a line to align vertically, +provided that it aligns with two or more other '=>' tokens. + +=item B + +The following message was generated when running perltidy on random text: + + Use of uninitialized value $K_semicolon in subtraction (-) at /home/steve/bin/Perl/Tidy/Formatter.pm line 16467. + +This was fixed 14 Sep 2020. + +=item B + +A rule was added to prevent a file consisting of a single semicolon + + ; + +from becoming a zero length file. This could cause problems with other +software. + +=item B + +The following message was generated when running perltidy on random text: + + Use of uninitialized value $cti in numeric eq (==) at /home/steve/bin/Perl/Tidy/Formatter.pm line 11926. + Use of uninitialized value $cti in numeric eq (==) at /home/steve/bin/Perl/Tidy/Formatter.pm line 11936. + Use of uninitialized value $cti in numeric eq (==) at /home/steve/bin/Perl/Tidy/Formatter.pm line 11944. + +This was fixed 13 Sep 2020 in 'fixed unitialized variable problem ', adb2096. + +=item B + +The following message was generated when running perltidy on random text: + + substr outside of string at /home/steve/bin/Perl/Tidy/Tokenizer.pm line 7362. + Use of uninitialized value in concatenation (.) or string at /home/steve/bin/Perl/Tidy/Tokenizer.pm line 7362. + +This was fixed 13 Sep 2020 in 'fixed unitialized variable problem', 5bf49a3. + +=item B + +The following message was generated when running perltidy on random text: + + Use of uninitialized value $K_opening in subtraction (-) at /home/steve/bin/Perl/Tidy/Formatter.pm line 16467. + +This was fixed 13 Sep 2020 in 'fix undefined variable reference', 1919482. + +=item B + +The following snippet generated a warning that there might be a hash-bang +after the start of the script. + + $x = 2; + #! sunos does not yet provide a /usr/bin/perl + $script = "$^X $script"; + +To prevent this annoyance, the warning is not given unless the first nonblank +character after the '#!' is a '/'. Note that this change is just for the +warning message. The actual hash bang check does not require the slash. + + =item B An unitialized index was referenced when running on a file of randomly generated text: Use of uninitialized value $K_oo in subtraction (-) at /home/steve/bin/Perl/Tidy/Formatter.pm line 7259. -This was fixed 12 Sep 2020. +This was fixed 12 Sep 2020 in 'fixed undefined index', 616bb88. =item B diff --git a/t/snippets/expect/kgb1.def b/t/snippets/expect/kgb1.def index bfe691f2..f6d9f3ae 100644 --- a/t/snippets/expect/kgb1.def +++ b/t/snippets/expect/kgb1.def @@ -101,7 +101,7 @@ my %extractor_for = ( $ncws, { DONT_MATCH => $pod_or_DATA }, $variable, $id, { DONT_MATCH => \&extract_quotelike } ], - executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ], + executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ], executable_no_comments => [ { DONT_MATCH => $comment }, $ncws, { DONT_MATCH => $pod_or_DATA } ], all => [ { MATCH => qr/(?s:.*)/ } ], diff --git a/t/snippets/expect/kgb1.kgb b/t/snippets/expect/kgb1.kgb index 2382bf82..688aeb20 100644 --- a/t/snippets/expect/kgb1.kgb +++ b/t/snippets/expect/kgb1.kgb @@ -104,7 +104,7 @@ my %extractor_for = ( $ncws, { DONT_MATCH => $pod_or_DATA }, $variable, $id, { DONT_MATCH => \&extract_quotelike } ], - executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ], + executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ], executable_no_comments => [ { DONT_MATCH => $comment }, $ncws, { DONT_MATCH => $pod_or_DATA } ], all => [ { MATCH => qr/(?s:.*)/ } ], diff --git a/t/snippets/perltidy_random_parameters.pl b/t/snippets/perltidy_random_parameters.pl index eca31c35..df1688d7 100755 --- a/t/snippets/perltidy_random_parameters.pl +++ b/t/snippets/perltidy_random_parameters.pl @@ -113,7 +113,7 @@ foreach my $file (@files) { # Case 2 creates the smallest possible output file size if ($case == 2) { - $rrandom_parameters = [ "--mangle -dac -i=0 -ci=0" ]; + $rrandom_parameters = [ "--mangle -dsc -dac -i=0 -ci=0 -it=2" ]; } # Case 3 checks extrude from mangle (case 2) @@ -175,8 +175,18 @@ foreach my $file (@files) { $ofile_case_max = $ofile; } } + + # Min possible size is the min of cases 2 and 3 + # Save this to check other results for file truncation if ( $case == 2 ) { $ofile_size_min_expected = $ofile_size } - elsif ( $case > 2 && $ofile_size < 0.95 * $ofile_size_min_expected ) + elsif ( $case == 3 ) { + if ( $ofile_size < $ofile_size_min_expected ) { + $ofile_size_min_expected = $ofile_size; + } + } + + # Check for unexpectedly very small file size + elsif ( $case > 3 && $ofile_size < 0.6 * $ofile_size_min_expected ) { print STDERR "**ERROR for ofile=$ofile: size = $ofile_size < $ofile_size_min_expected = min expected\n"; diff --git a/t/snippets/random_file_generator.pl b/t/snippets/random_file_generator.pl index 56fd3cd3..ced0738e 100755 --- a/t/snippets/random_file_generator.pl +++ b/t/snippets/random_file_generator.pl @@ -70,20 +70,32 @@ for ( my $nf = 1 ; $nf <= $max_cases ; $nf++ ) { my $frac = rand(1); my $ix = int( rand($nsources) ); $ix = random_index( $nsources - 1 ); - my $method = random_index(2); + my $NMETH = 4; + my $method = random_index(3); my $rfile; - if ( $method == 2 ) { + if ( $method == 3 ) { my $nchars=1+random_index(1000); $rfile = random_characters($nchars); print STDERR "Method $method, nchars=$nchars\n"; } - elsif ( $method == 1 ) { + elsif ( $method == 2 ) { $rfile = skip_random_lines( $rsource_files->[$ix], $frac ); print STDERR "Method $method, frac=$frac, file=$ix\n"; } - else { + elsif ( $method == 1 ) { $rfile = select_random_lines( $rsource_files->[$ix], $frac ); print STDERR "Method $method, frac=$frac, file=$ix\n"; + } + elsif ( $method == 0 ) { + $rfile = reverse_random_lines( $rsource_files->[$ix], $frac ); +print STDERR "Method $method, frac=$frac, file=$ix\n"; + } + + # Shouldn't happen + else { + my $nchars=1+random_index(1000); + $rfile = random_characters($nchars); +print STDERR "FIXME: method=$method but NMETH=$NMETH; Method $method, nchars=$nchars\n"; } open( OUT, ">", $fname ) || die "cannot open $fname: $!\n"; foreach my $line ( @{$rfile} ) { @@ -144,6 +156,37 @@ sub select_random_lines { return \@selected; } +sub reverse_random_lines { + + # skip some fraction of the lines in a source file + # but keep lines in the original order + my ($rsource, $frand) = @_; + + my %select; + my $nlines = @{$rsource}; + my $num_delete = $nlines*$frand; + my $count=0; + while ($count < $num_delete) { + my $ii = rand($nlines); + $ii = int($ii); + $select{$ii} = 1; + $count++; + } + + my @lines; + my $jj = -1; + foreach my $line (@{$rsource}) { + $jj++; + if ($select{$jj} ) { + chomp $line; + $line = reverse($line); + $line .= "\n"; + }; + push @lines, $line; + } + return \@lines; +} + sub skip_random_lines { # skip some fraction of the lines in a source file diff --git a/t/snippets14.t b/t/snippets14.t index 209a780d..5c715ca6 100644 --- a/t/snippets14.t +++ b/t/snippets14.t @@ -576,7 +576,7 @@ my %extractor_for = ( $ncws, { DONT_MATCH => $pod_or_DATA }, $variable, $id, { DONT_MATCH => \&extract_quotelike } ], - executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ], + executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ], executable_no_comments => [ { DONT_MATCH => $comment }, $ncws, { DONT_MATCH => $pod_or_DATA } ], all => [ { MATCH => qr/(?s:.*)/ } ], @@ -695,7 +695,7 @@ my %extractor_for = ( $ncws, { DONT_MATCH => $pod_or_DATA }, $variable, $id, { DONT_MATCH => \&extract_quotelike } ], - executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ], + executable => [ $ws, { DONT_MATCH => $pod_or_DATA } ], executable_no_comments => [ { DONT_MATCH => $comment }, $ncws, { DONT_MATCH => $pod_or_DATA } ], all => [ { MATCH => qr/(?s:.*)/ } ], diff --git a/t/snippets17.t b/t/snippets17.t index e5e78c68..27b37534 100644 --- a/t/snippets17.t +++ b/t/snippets17.t @@ -65,7 +65,7 @@ BEGIN { 'def' => "", 'long_line' => "-l=0", 'pbp' => "-pbp -nst -nse", - 'rperl' => + 'rperl' => "-pbp -nst --ignore-side-comment-lengths --converge -l=0 -q", 'rt132059' => "-dac", };