@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
# 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} );
# ...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 ';' );
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] );
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() -
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 {
}
}
+ $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...
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 '=~' ) {
=over
+=item B<Allow vertical alignment of line-ending fat comma>
+
+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<fixed uninitialized value reference>
+
+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<Do not create a zero size file by deleting semicolons>
+
+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<fixed uninitialized value reference>
+
+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<fixed uninitialized value reference>
+
+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<fixed uninitialized value reference>
+
+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<hashbang warning changed>
+
+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<uninitialized index referenced>
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<Oops message triggered>
$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:.*)/ } ],
$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:.*)/ } ],
# 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)
$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";
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} ) {
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
$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:.*)/ } ],
$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:.*)/ } ],
'def' => "",
'long_line' => "-l=0",
'pbp' => "-pbp -nst -nse",
- 'rperl' =>
+ 'rperl' =>
"-pbp -nst --ignore-side-comment-lengths --converge -l=0 -q",
'rt132059' => "-dac",
};
projects / perltidy.git / commitdiff