# These are used below to prevent unwanted cross-line alignments.
# Unbalanced containers already avoid aligning across
# container boundaries.
- my $tok = $tokens_to_go[$i];
+ my $tok = $tokens_to_go[$i];
+ my $depth_last = $depth;
if ( $tok =~ /^[\(\{\[]/ ) { #'(' ) {
# if container is balanced on this line...
# also decorate commas with any container name to avoid
# unwanted cross-line alignments.
if ( $raw_tok eq ',' || $raw_tok eq '=>' ) {
- if ( $container_name[$depth] ) {
- $tok .= $container_name[$depth];
+
+ # If we are at an opening token which increased depth, we have
+ # to use the name from the previous depth.
+ my $depth_p = ( $depth_last < $depth ? $depth_last : $depth );
+ if ( $container_name[$depth_p] ) {
+ $tok .= $container_name[$depth_p];
}
}
sub get_line_token_info {
- # Scan lines of tokens and return summary information about the range of
+ # scan lines of tokens and return summary information about the range of
# levels and patterns.
my ($rlines) = @_;
+ # First scan to check monotonicity. Here is an example of several
+ # lines which are monotonic. The = is the lowest level, and
+ # the commas are all one level deeper. So this is not nonmonotonic.
+ # $$d{"weeks"} = [ "w", "wk", "wks", "week", "weeks" ];
+ # $$d{"days"} = [ "d", "day", "days" ];
+ # $$d{"hours"} = [ "h", "hr", "hrs", "hour", "hours" ];
+ my @all_token_info;
+ my $all_monotonic = 1;
+ for ( my $jj = 0 ; $jj < @{$rlines} ; $jj++ ) {
+ my ($line) = $rlines->[$jj];
+ my $rtokens = $line->get_rtokens();
+ my $last_lev;
+ my $is_monotonic = 1;
+ my $i = -1;
+ foreach my $tok ( @{$rtokens} ) {
+ $i++;
+ my ( $raw_tok, $lev, $tag, $tok_count ) =
+ decode_alignment_token($tok);
+ push @{ $all_token_info[$jj] },
+ [ $raw_tok, $lev, $tag, $tok_count ];
+ last if ( $tok eq '#' );
+ if ( $i > 0 && $lev < $last_lev ) { $is_monotonic = 0 }
+ $last_lev = $lev;
+ }
+ if ( !$is_monotonic ) { $all_monotonic = 0 }
+ }
+
my $rline_values = [];
for ( my $jj = 0 ; $jj < @{$rlines} ; $jj++ ) {
my ($line) = $rlines->[$jj];
my $token_pattern_max = "";
my %saw_level;
my @token_info;
+ my $is_monotonic = 1;
- # Find the index of the last token before the side comment
+ # find the index of the last token before the side comment
my $imax = @{$rtokens} - 2;
- # But if the line ends in a comma list, walk it back to the first such
- # comma. This will have the effect of making all trailing ragged comma
- # lists match in the prune tree routine. These trailing comma lists
- # can better be handled by later alignment rules.
+ # If the entire group is monotonic, and the line ends in a comma list,
+ # walk it back to the first such comma. this will have the effect of
+ # making all trailing ragged comma lists match in the prune tree
+ # routine. these trailing comma lists can better be handled by later
+ # alignment rules.
my $tok_end = $rtokens->[$imax];
- if ( $tok_end =~ /^,/ ) {
+ if ( $all_monotonic && $tok_end =~ /^,/ ) {
my $i = $imax - 1;
while ( $i >= 0 && $rtokens->[$i] eq $tok_end ) {
$imax = $i;
}
# make a first pass to find level range
+ my $last_lev;
foreach my $tok ( @{$rtokens} ) {
$i++;
last if ( $i > $imax );
+ last if ($tok eq '#');
my ( $raw_tok, $lev, $tag, $tok_count ) =
- decode_alignment_token($tok);
- push @token_info, [ $raw_tok, $lev, $tag, $tok_count ];
+ @{$all_token_info[$jj]->[$i]};
+
last if ( $tok eq '#' );
$token_pattern_max .= $tok;
$saw_level{$lev}++;
$lev_max = $lev;
}
else {
- if ( $lev < $lev_min ) { $lev_min = $lev; }
- if ( $lev > $lev_max ) { $lev_max = $lev; }
+ if ( $lev < $lev_min ) { $lev_min = $lev; }
+ if ( $lev > $lev_max ) { $lev_max = $lev; }
+ if ( $lev < $last_lev ) { $is_monotonic = 0 }
}
+ $last_lev = $lev;
}
# handle no levels
$rtoken_patterns->{$lev_max} = $token_pattern_max;
$rtoken_indexes->{$lev_max} = [ ( 0 .. $imax ) ];
- my $DEBUG = 0;
+ my $debug = 0;
my $lev_top = pop @levs; # alread did max level
my $itok = -1;
foreach my $tok ( @{$rtokens} ) {
$itok++;
last if ( $itok > $imax );
+ ##my ( $raw_tok, $lev, $tag, $tok_count ) = @{ $token_info[$itok] };
my ( $raw_tok, $lev, $tag, $tok_count ) =
- @{ $token_info[$itok] };
+ @{$all_token_info[$jj]->[$itok]};
last if ( $raw_tok eq '#' );
foreach my $lev_test (@levs) {
next if ( $lev > $lev_test );
}
push @{$rline_values},
- [ $lev_min, $lev_max, $rtoken_patterns, \@levs, $rtoken_indexes, ];
+ [
+ $lev_min, $lev_max, $rtoken_patterns,
+ \@levs, $rtoken_indexes, $is_monotonic
+ ];
- # DEBUG
+ # debug
0 && do {
local $" = ')(';
print "lev_min=$lev_min, lev_max=$lev_max, levels=(@levs)\n";
# $jbeg..$jend is the range of line indexes,
# $level_keep is the minimum level to keep
my @delete_list;
+ my %end_group;
my $starting_depth = 0; # normally 0 except for debugging
# nothing to do if no children
next unless defined($nc_beg_p);
- # Define the number of lines to either keep or delete a child node.
- # This is the key decision we have to make. We want to delete
- # short runs of matched lines, and keep long runs. The following
- # rule has given good results but it might be optimized in the
- # future to include more variables.
- my $nlines_keep = $depth + 3;
- my $nlines_p = $jend_p - $jbeg_p + 1;
- if ( $nlines_keep > $nlines_p - 1 ) { $nlines_keep = $nlines_p - 1 }
+ # Define the number of lines to either keep or delete a child node.
+ # This is the key decision we have to make. We want to delete
+ # short runs of matched lines, and keep long runs. It seems easier
+ # for the eye to follow breaks in monotonic level changes than
+ # non-monotonic level changes. For example, the following looks
+ # best if we delete the lower level alignments:
+
+ # [1] ~~ [];
+ # [ ["foo"], ["bar"] ] ~~ [ qr/o/, qr/a/ ];
+ # [ qr/o/, qr/a/ ] ~~ [ ["foo"], ["bar"] ];
+ # [ "foo", "bar" ] ~~ [ qr/o/, qr/a/ ];
+ # [ qr/o/, qr/a/ ] ~~ [ "foo", "bar" ];
+ # $deep1 ~~ $deep1;
+
+ # So we will use two thresholds.
+ my $nmin_mono = $depth + 3;
+ my $nmin_non_mono = $depth + 6;
+ my $nlines_p = $jend_p - $jbeg_p + 1;
+ if ( $nmin_mono > $nlines_p - 1 ) {
+ $nmin_mono = $nlines_p - 1;
+ }
+ if ( $nmin_non_mono > $nlines_p - 1 ) {
+ $nmin_non_mono = $nlines_p - 1;
+ }
# loop to keep or delete each child node
+ my $jend_c_keep;
foreach my $nc ( $nc_beg_p .. $nc_end_p ) {
my ( $jbeg_c, $jend_c, $np_c, $lev_c, $pat_c, $nc_beg_c,
$nc_end_c )
= @{ $match_tree[ $depth + 1 ]->[$nc] };
my $nlines_c = $jend_c - $jbeg_c + 1;
- if ( $nlines_c < $nlines_keep ) {
+ my $is_monotonic = $rline_values->[$jbeg_c]->[5];
+ my $nmin = $is_monotonic ? $nmin_mono : $nmin_non_mono;
+ if ( $nlines_c < $nmin ) {
push @delete_list, [ $jbeg_c, $jend_c, $lev_p ];
}
else {
+ if ( defined($jend_c_keep) && $jbeg_c == $jend_c_keep + 1 )
+ {
+ $rlines->[$jend_c_keep]->{_end_group} = 1;
+ }
+ $jend_c_keep = $jend_c;
push @todo_next, $nc;
}
}
my @fix = @{$item};
foreach (@fix) { $_ = "undef" unless defined $_; }
$fix[4] = "...";
- $fix[7] = "...";
print "(@fix)\n";
}
}
-# do not align commas here; different container types
+# do not align internal commas here; different container types
is_deeply( [ $a, $a ], [ $b, $c ] );
is_deeply( { foo => $a, bar => $a }, { foo => $b, bar => $c } );
is_deeply( [ \$a, \$a ], [ \$b, \$c ] );
-# do not align commas here; different container types
-is_deeply( [ $a, $a ], [ $b, $c ] );
+# do not align internal commas here; different container types
+is_deeply( [ $a, $a ], [ $b, $c ] );
is_deeply( { foo => $a, bar => $a }, { foo => $b, bar => $c } );
-is_deeply( [ \$a, \$a ], [ \$b, \$c ] );
+is_deeply( [ \$a, \$a ], [ \$b, \$c ] );
$_SetupComm = ff( "k32", "SetupComm", [ N, N, N ], I );
$_PurgeComm = ff( "k32", "PurgeComm", [ N, N ], I );
$_CreateEvent = ff( "k32", "CreateEvent", [ P, I, I, P ], N );
+
+is_deeply \@t, [
+
+ [3], [0], [1], [0],
+ 3, [1], 3, [1],
+ 2, [0], [1], [0],
+ [1], [1], [1], 2,
+ 3, [1], 2, [3],
+ 4, [ 7, 8 ], 9, ["a"],
+ "b", 3, 2, 5,
+ 3, 2, 5, 3,
+ [2], 5, 4, 5,
+ [ 3, 2, 1 ], 1, 2, 3,
+ [ -1, -2, -3 ], [ -1, -2, -3 ], [ -1, -2, -3 ], [ -1, -2 ],
+ 3, [ -1, -2 ], 3, [ -1, -2, -3 ],
+ [ !1 ], [ 8, 7, 6 ], [ 8, 7, 6 ], [4],
+ !!0,
+];
if ( -e $diff_file ) {
$diff_msg = <<EOM;
Look at each differences in '$diff_file'
-The full old ouput for 'somefile.def' is in expect/somefile.def
-The full new ouput for 'somefile.def' is in tmp/somefile.def
+The full old output for 'somefile.def' is in expect/somefile.def
+The full new output for 'somefile.def' is in tmp/somefile.def
EOM
}
../snippets21.t switch_plain.switch_plain
../snippets21.t sot.def
../snippets21.t sot.sot
+../snippets21.t prune.def
../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
-../snippets21.t prune.def
$_SetupComm = ff( "k32", "SetupComm", [ N, N, N ], I );
$_PurgeComm = ff( "k32", "PurgeComm", [ N, N ], I );
$_CreateEvent = ff( "k32", "CreateEvent", [ P, I, I, P ], N );
+
+
+is_deeply \@t, [
+
+ [3], [0], [1], [0],
+ 3, [1], 3, [1],
+ 2, [0], [1], [0],
+ [1], [1], [1], 2,
+ 3, [1], 2, [3],
+ 4, [ 7, 8 ], 9, ["a"],
+ "b", 3, 2, 5,
+ 3, 2, 5, 3,
+ [2], 5, 4, 5,
+ [ 3, 2, 1 ], 1, 2, 3,
+ [ -1, -2, -3 ], [ -1, -2, -3 ], [ -1, -2, -3 ], [ -1, -2 ],
+ 3, [ -1, -2 ], 3, [ -1, -2, -3 ],
+ [ !1 ], [ 8, 7, 6 ], [ 8, 7, 6 ], [4],
+ !!0,
+];
----------
'align25' => <<'----------',
-# do not align commas here; different container types
+# do not align internal commas here; different container types
is_deeply( [ $a, $a ], [ $b, $c ] );
is_deeply( { foo => $a, bar => $a }, { foo => $b, bar => $c } );
is_deeply( [ \$a, \$a ], [ \$b, \$c ] );
source => "align25",
params => "def",
expect => <<'#17...........',
-# do not align commas here; different container types
-is_deeply( [ $a, $a ], [ $b, $c ] );
+# do not align internal commas here; different container types
+is_deeply( [ $a, $a ], [ $b, $c ] );
is_deeply( { foo => $a, bar => $a }, { foo => $b, bar => $c } );
-is_deeply( [ \$a, \$a ], [ \$b, \$c ] );
+is_deeply( [ \$a, \$a ], [ \$b, \$c ] );
#17...........
},
$_SetupComm = ff( "k32", "SetupComm", [ N, N, N ], I );
$_PurgeComm = ff( "k32", "PurgeComm", [ N, N ], I );
$_CreateEvent = ff( "k32", "CreateEvent", [ P, I, I, P ], N );
+
+
+is_deeply \@t, [
+
+ [3], [0], [1], [0],
+ 3, [1], 3, [1],
+ 2, [0], [1], [0],
+ [1], [1], [1], 2,
+ 3, [1], 2, [3],
+ 4, [ 7, 8 ], 9, ["a"],
+ "b", 3, 2, 5,
+ 3, 2, 5, 3,
+ [2], 5, 4, 5,
+ [ 3, 2, 1 ], 1, 2, 3,
+ [ -1, -2, -3 ], [ -1, -2, -3 ], [ -1, -2, -3 ], [ -1, -2 ],
+ 3, [ -1, -2 ], 3, [ -1, -2, -3 ],
+ [ !1 ], [ 8, 7, 6 ], [ 8, 7, 6 ], [4],
+ !!0,
+];
----------
'sot' => <<'----------',
$_SetupComm = ff( "k32", "SetupComm", [ N, N, N ], I );
$_PurgeComm = ff( "k32", "PurgeComm", [ N, N ], I );
$_CreateEvent = ff( "k32", "CreateEvent", [ P, I, I, P ], N );
+
+is_deeply \@t, [
+
+ [3], [0], [1], [0],
+ 3, [1], 3, [1],
+ 2, [0], [1], [0],
+ [1], [1], [1], 2,
+ 3, [1], 2, [3],
+ 4, [ 7, 8 ], 9, ["a"],
+ "b", 3, 2, 5,
+ 3, 2, 5, 3,
+ [2], 5, 4, 5,
+ [ 3, 2, 1 ], 1, 2, 3,
+ [ -1, -2, -3 ], [ -1, -2, -3 ], [ -1, -2, -3 ], [ -1, -2 ],
+ 3, [ -1, -2 ], 3, [ -1, -2, -3 ],
+ [ !1 ], [ 8, 7, 6 ], [ 8, 7, 6 ], [4],
+ !!0,
+];
#6...........
},
};
projects / perltidy.git / commitdiff