# ignore hanging side comments in these operations
my @filtered = grep { !$_->{_is_hanging_side_comment} } @{$rlines};
my $rnew_lines = \@filtered;
- my @i_equals;
+ my @equals_info;
my @line_info;
my $jmax = @{$rnew_lines} - 1;
my $saw_list_type;
my $max_lev_diff = 0;
foreach my $line ( @{$rnew_lines} ) {
- my $rhash = {};
- my $rtokens = $line->get_rtokens();
+ my $rhash = {};
+ my $rtokens = $line->get_rtokens();
+ my $rpatterns = $line->get_rpatterns();
if ( !$saw_list_type && $line->get_list_type() ) { $saw_list_type = 1 }
my $i = 0;
- my $i_eq;
+ my ( $i_eq, $tok_eq, $pat_eq );
my ( $lev_min, $lev_max );
foreach my $tok ( @{$rtokens} ) {
my ( $raw_tok, $lev, $tag, $tok_count ) =
# remember the first equals at line level
if ( !defined($i_eq) && $raw_tok eq '=' ) {
- if ( $lev eq $group_level ) { $i_eq = $i }
+
+ if ( $lev eq $group_level ) {
+ $i_eq = $i;
+ $tok_eq = $tok;
+ $pat_eq = $rpatterns->[$i];
+ }
}
$i++;
}
push @{$rline_hashes}, $rhash;
- push @i_equals, $i_eq;
+ push @equals_info, [ $i_eq, $tok_eq, $pat_eq ];
push @line_info, [ $lev_min, $lev_max ];
if ( defined($lev_min) ) {
my $lev_diff = $lev_max - $lev_min;
if ( $nr == 0 && $nl > 0 ) {
$rnew_lines->[$jl]->{_end_group} = 1;
}
+
+ # Also set a line break if both lines have simple equals but with
+ # different leading characters in patterns. This check is similar to
+ # one in sub check_match, and will prevent sub prune_alignment_tree
+ # from removing alignments which otherwise should be kept. This fix
+ # is rarely needed, but it can occasionally improve formatting.
+ # For example:
+ # my $name = $this->{Name};
+ # $type = $this->ctype($genlooptype) if defined $genlooptype;
+ # my $declini = ( $asgnonly ? "" : "\t$type *" );
+ # my $cast = ( $type ? "($type *)" : "" );
+ # The last two lines start with 'my' and will not match the previous
+ # line starting with $type, so we do not want prune_alignment tree
+ # to delete their ? : alignments at a deeper level.
+ my ( $i_eq_l, $tok_eq_l, $pat_eq_l ) = @{ $equals_info[$jl] };
+ my ( $i_eq_r, $tok_eq_r, $pat_eq_r ) = @{ $equals_info[$jr] };
+ if ( defined($i_eq_l) && defined($i_eq_r) ) {
+ if ( $tok_eq_l eq $tok_eq_r
+ && $i_eq_l == 0
+ && $i_eq_r == 0
+ && substr( $pat_eq_l, 0, 1 ) ne substr( $pat_eq_r, 0, 1 ) )
+ {
+ $rnew_lines->[$jl]->{_end_group} = 1;
+ }
+ }
}
# find subgroups
my $line = $rnew_lines->[$jj];
my $rtokens = $line->get_rtokens();
my $rhash = $rline_hashes->[$jj];
- my $i_eq = $i_equals[$jj];
+ my $i_eq = $equals_info[$jj]->[0];
my @idel;
my $imax = @{$rtokens} - 2;
my $delete_above_level;
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
+ # 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];
elsif ( $lev_max == $lev_min ) {
$rtoken_patterns->{$lev_max} = $token_pattern_max;
$rtoken_indexes->{$lev_max} = [ ( 0 .. $imax ) ];
-
- #return ( $lev_min, $lev_max, $rtoken_patterns );
}
# handle multiple levels
my @match_tree;
# Tree nodes contain these values:
- # $match_tree[$depth] = [$jbeg, $jend, $n_parent, $level, $pattern]
- # $depth = 0,1,2 = index of depth of the match
+ # $match_tree[$depth] = [$jbeg, $jend, $n_parent, $level, $pattern,
+ # $nc_beg_p, $nc_end_p, $rindexes];
+ # where
+ # $depth = 0,1,2 = index of depth of the match
# $jbeg beginning index j of the range of lines in this match
# $jend ending index j of the range of lines in this match
--- /dev/null
+# some tests for 'sub prune_alignment_tree'
+
+$request->header( 'User-Agent' => $agent ) if $agent;
+$request->header( 'From' => $from ) if $from;
+$request->header( 'Range' => "bytes=0-$max_size" ) if $max_size;
+
+for (
+ [ 'CONSTANT', sub { join "foo", "bar" }, 0, "bar" ],
+ [ 'CONSTANT', sub { join "foo", "bar", 3 }, 1, "barfoo3" ],
+ [ '$var', sub { join $_, "bar" }, 0, "bar" ],
+ [ '$myvar', sub { my $var; join $var, "bar" }, 0, "bar" ],
+);
+
+[
+ [ [NewXSHdr], [ NewXSName, NewXSArgs ], "XSHdr" ],
+ [ [NewXSCHdrs], [ NewXSName, NewXSArgs, GlobalNew ], "XSCHdrs" ],
+ [ [DefSyms], [StructName], "MkDefSyms" ],
+ [ [NewXSSymTab], [ DefSyms, NewXSArgs ], "AddArgsyms" ],
+ [ [NewXSLocals], [NewXSSymTab], "Sym2Loc" ],
+ [ [IsAffineFlag], [], sub { return "0" } ],
+];
+
+@degen_nums[ 1, 2, 4, 8 ] = ( 'a', 'c', 'g', 't' );
+@degen_nums[ 5, 10, 9, 6, 3, 12 ] = ( 'r', 'y', 'w', 's', 'm', 'k' );
+@degen_nums[ 14, 13, 11, 7, 15 ] = ( 'b', 'd', 'h', 'v', 'n' );
+
+$_CreateFile = ff( "k32", "CreateFile", [ P, N, N, N, N, N, N ], N );
+$_CloseHandle = ff( "k32", "CloseHandle", [N], N );
+$_GetCommState = ff( "k32", "GetCommState", [ N, P ], I );
+$_SetCommState = ff( "k32", "SetCommState", [ N, P ], I );
+$_SetupComm = ff( "k32", "SetupComm", [ N, N, N ], I );
+$_PurgeComm = ff( "k32", "PurgeComm", [ N, N ], I );
+$_CreateEvent = ff( "k32", "CreateEvent", [ P, I, I, P ], N );
../snippets9.t rt98902.def
../snippets9.t rt98902.rt98902
../snippets9.t rt99961.def
+../snippets21.t prune.def
--- /dev/null
+# some tests for 'sub prune_alignment_tree'
+
+$request->header( 'User-Agent' => $agent ) if $agent;
+$request->header( 'From' => $from ) if $from;
+$request->header( 'Range' => "bytes=0-$max_size" ) if $max_size;
+
+for (
+ [ 'CONSTANT', sub { join "foo", "bar" }, 0, "bar" ],
+ [ 'CONSTANT', sub { join "foo", "bar", 3 }, 1, "barfoo3" ],
+ [ '$var', sub { join $_, "bar" }, 0, "bar" ],
+ [ '$myvar', sub { my $var; join $var, "bar" }, 0, "bar" ],
+);
+
+[
+ [ [NewXSHdr], [ NewXSName, NewXSArgs ], "XSHdr" ],
+ [ [NewXSCHdrs], [ NewXSName, NewXSArgs, GlobalNew ], "XSCHdrs" ],
+ [ [DefSyms], [StructName], "MkDefSyms" ],
+ [ [NewXSSymTab], [ DefSyms, NewXSArgs ], "AddArgsyms" ],
+ [ [NewXSLocals], [NewXSSymTab], "Sym2Loc" ],
+ [ [IsAffineFlag], [], sub { return "0" } ],
+];
+
+@degen_nums[ 1, 2, 4, 8 ] = ( 'a', 'c', 'g', 't' );
+@degen_nums[ 5, 10, 9, 6, 3, 12 ] = ( 'r', 'y', 'w', 's', 'm', 'k' );
+@degen_nums[ 14, 13, 11, 7, 15 ] = ( 'b', 'd', 'h', 'v', 'n' );
+
+$_CreateFile = ff( "k32", "CreateFile", [ P, N, N, N, N, N, N ], N );
+$_CloseHandle = ff( "k32", "CloseHandle", [N], N );
+$_GetCommState = ff( "k32", "GetCommState", [ N, P ], I );
+$_SetCommState = ff( "k32", "SetCommState", [ N, P ], I );
+$_SetupComm = ff( "k32", "SetupComm", [ N, N, N ], I );
+$_PurgeComm = ff( "k32", "PurgeComm", [ N, N ], I );
+$_CreateEvent = ff( "k32", "CreateEvent", [ P, I, I, P ], N );
#3 switch_plain.switch_plain
#4 sot.def
#5 sot.sot
+#6 prune.def
# To locate test #13 you can search for its name or the string '#13'
|| 'text/plain' );
----------
+ 'prune' => <<'----------',
+# some tests for 'sub prune_alignment_tree'
+
+$request->header( 'User-Agent' => $agent ) if $agent;
+$request->header( 'From' => $from ) if $from;
+$request->header( 'Range' => "bytes=0-$max_size" ) if $max_size;
+
+for (
+ [ 'CONSTANT', sub { join "foo", "bar" }, 0, "bar" ],
+ [ 'CONSTANT', sub { join "foo", "bar", 3 }, 1, "barfoo3" ],
+ [ '$var', sub { join $_, "bar" }, 0, "bar" ],
+ [ '$myvar', sub { my $var; join $var, "bar" }, 0, "bar" ],
+);
+
+[
+ [ [NewXSHdr], [ NewXSName, NewXSArgs ], "XSHdr" ],
+ [ [NewXSCHdrs], [ NewXSName, NewXSArgs, GlobalNew ], "XSCHdrs" ],
+ [ [DefSyms], [StructName], "MkDefSyms" ],
+ [ [NewXSSymTab], [ DefSyms, NewXSArgs ], "AddArgsyms" ],
+ [ [NewXSLocals], [NewXSSymTab], "Sym2Loc" ],
+ [ [IsAffineFlag], [], sub { return "0" } ],
+];
+
+@degen_nums[ 1, 2, 4, 8 ] = ( 'a', 'c', 'g', 't' );
+@degen_nums[ 5, 10, 9, 6, 3, 12 ] = ( 'r', 'y', 'w', 's', 'm', 'k' );
+@degen_nums[ 14, 13, 11, 7, 15 ] = ( 'b', 'd', 'h', 'v', 'n' );
+
+$_CreateFile = ff( "k32", "CreateFile", [ P, N, N, N, N, N, N ], N );
+$_CloseHandle = ff( "k32", "CloseHandle", [N], N );
+$_GetCommState = ff( "k32", "GetCommState", [ N, P ], I );
+$_SetCommState = ff( "k32", "SetCommState", [ N, P ], I );
+$_SetupComm = ff( "k32", "SetupComm", [ N, N, N ], I );
+$_PurgeComm = ff( "k32", "PurgeComm", [ N, N ], I );
+$_CreateEvent = ff( "k32", "CreateEvent", [ P, I, I, P ], N );
+----------
+
'sot' => <<'----------',
$opt_c = Text::CSV_XS->new(
{
) );
#5...........
},
+
+ 'prune.def' => {
+ source => "prune",
+ params => "def",
+ expect => <<'#6...........',
+# some tests for 'sub prune_alignment_tree'
+
+$request->header( 'User-Agent' => $agent ) if $agent;
+$request->header( 'From' => $from ) if $from;
+$request->header( 'Range' => "bytes=0-$max_size" ) if $max_size;
+
+for (
+ [ 'CONSTANT', sub { join "foo", "bar" }, 0, "bar" ],
+ [ 'CONSTANT', sub { join "foo", "bar", 3 }, 1, "barfoo3" ],
+ [ '$var', sub { join $_, "bar" }, 0, "bar" ],
+ [ '$myvar', sub { my $var; join $var, "bar" }, 0, "bar" ],
+);
+
+[
+ [ [NewXSHdr], [ NewXSName, NewXSArgs ], "XSHdr" ],
+ [ [NewXSCHdrs], [ NewXSName, NewXSArgs, GlobalNew ], "XSCHdrs" ],
+ [ [DefSyms], [StructName], "MkDefSyms" ],
+ [ [NewXSSymTab], [ DefSyms, NewXSArgs ], "AddArgsyms" ],
+ [ [NewXSLocals], [NewXSSymTab], "Sym2Loc" ],
+ [ [IsAffineFlag], [], sub { return "0" } ],
+];
+
+@degen_nums[ 1, 2, 4, 8 ] = ( 'a', 'c', 'g', 't' );
+@degen_nums[ 5, 10, 9, 6, 3, 12 ] = ( 'r', 'y', 'w', 's', 'm', 'k' );
+@degen_nums[ 14, 13, 11, 7, 15 ] = ( 'b', 'd', 'h', 'v', 'n' );
+
+$_CreateFile = ff( "k32", "CreateFile", [ P, N, N, N, N, N, N ], N );
+$_CloseHandle = ff( "k32", "CloseHandle", [N], N );
+$_GetCommState = ff( "k32", "GetCommState", [ N, P ], I );
+$_SetCommState = ff( "k32", "SetCommState", [ N, P ], I );
+$_SetupComm = ff( "k32", "SetupComm", [ N, N, N ], I );
+$_PurgeComm = ff( "k32", "PurgeComm", [ N, N ], I );
+$_CreateEvent = ff( "k32", "CreateEvent", [ P, I, I, P ], N );
+#6...........
+ },
};
my $ntests = 0 + keys %{$rtests};