_ris_broken_container_ => $i++,
_ris_permanently_broken_container_ => $i++,
_rhas_broken_container_ => $i++,
+ _rhas_broken_list_ => $i++,
_rwant_reduced_ci_ => $i++,
_ris_bli_container_ => $i++,
_rparent_of_seqno_ => $i++,
$self->[_ris_broken_container_] = {};
$self->[_ris_permanently_broken_container_] = {};
$self->[_rhas_broken_container_] = {};
+ $self->[_rhas_broken_list_] = {};
$self->[_rwant_reduced_ci_] = {};
$self->[_ris_bli_container_] = {};
$self->[_rparent_of_seqno_] = {};
my $ris_broken_container = {};
my $ris_permanently_broken_container = {};
my $rhas_broken_container = {};
+ my $rhas_broken_list = {};
my $rparent_of_seqno = {};
my $rchildren_of_seqno = {};
# any phantom semicolons so that they will be counted in
# the correct container.
$depth_next--;
-
- # keep track of broken lists for later formatting
- my $seqno_test = $seqno_stack{$depth_next};
- my $KK_open = $KK_stack{$depth_next};
- my $seqno_outer = $seqno_stack{ $depth_next - 1 };
- if ( defined($seqno_test)
- && defined($KK_open)
- && $seqno_test == $type_sequence )
- {
- my $lx_open = $rLL->[$KK_open]->[_LINE_INDEX_];
- my $lx_close = $rLL->[$KK]->[_LINE_INDEX_];
- if ( $lx_open < $lx_close ) {
- $ris_broken_container->{$type_sequence} =
- $lx_close - $lx_open;
- if ( $rtype_count_by_seqno->{$seqno_test}->{','}
- && defined($seqno_outer) )
- {
- $rhas_broken_container->{$seqno_outer} = 1;
- }
- }
- }
}
}
# Find and remember lists by sequence number
my $ris_list_by_seqno = {};
foreach my $seqno ( keys %{$K_opening_container} ) {
- my $K_opening = $K_opening_container->{$seqno};
+ my $K_opening = $K_opening_container->{$seqno};
+ next unless defined($K_opening);
+
+ # only for lists, not for code blocks
my $block_type = $rLL_new->[$K_opening]->[_BLOCK_TYPE_];
next if ($block_type);
+
+ # code errors may leave undefined closing tokens
+ my $K_closing = $K_closing_container->{$seqno};
+ next unless defined($K_closing);
+
my $rtype_count = $rtype_count_by_seqno->{$seqno};
next unless ($rtype_count);
my $comma_count = $rtype_count->{','};
+ my $fat_comma_count = $rtype_count->{'=>'};
my $semicolon_count = $rtype_count->{';'};
# We will define a list to be a container with one or more commas and
- # no semicolons. Previously we allowed either a comma or fat comma,
- # but requiring a comma gives a guarantee later routines that there
- # is a good line break point within the list. This is useful because
- # we are mainly concerned with formatting and vertically aligning
- # multiple-line lists here.
- if ( $comma_count && !$semicolon_count ) {
- $ris_list_by_seqno->{$seqno} = $seqno;
+ # no semicolons.
+ my $is_list = ( $comma_count || $fat_comma_count ) && !$semicolon_count;
+ if ($is_list) { $ris_list_by_seqno->{$seqno} = $seqno }
+
+ my $lx_open = $rLL_new->[$K_opening]->[_LINE_INDEX_];
+ my $lx_close = $rLL_new->[$K_closing]->[_LINE_INDEX_];
+ my $line_diff = $lx_close - $lx_open;
+
+ if ($line_diff) {
+ $ris_broken_container->{$seqno} = $line_diff;
+ my $seqno_parent = $rparent_of_seqno->{$seqno};
+ if ( defined($seqno_parent) && $seqno_parent ne SEQ_ROOT ) {
+ $rhas_broken_container->{$seqno_parent} = 1;
+ $rhas_broken_list->{$seqno_parent} = 1 if ($is_list);
+ }
}
}
$self->[_rlec_count_by_seqno_] = $rlec_count_by_seqno;
$self->[_ris_broken_container_] = $ris_broken_container;
$self->[_rhas_broken_container_] = $rhas_broken_container;
+ $self->[_rhas_broken_list_] = $rhas_broken_list;
$self->[_rparent_of_seqno_] = $rparent_of_seqno;
$self->[_rchildren_of_seqno_] = $rchildren_of_seqno;
$self->[_ris_list_by_seqno_] = $ris_list_by_seqno;
my $ris_broken_container = $self->[_ris_broken_container_];
my $ris_permanently_broken_container =
$self->[_ris_permanently_broken_container_];
+ my $rhas_broken_list = $self->[_rhas_broken_list_];
my $rhas_broken_container = $self->[_rhas_broken_container_];
my $radjusted_levels = $self->[_radjusted_levels_];
my $rparent_of_seqno = $self->[_rparent_of_seqno_];
my $KK = $K_opening_container->{$seqno};
my $is_list = $self->is_list_by_seqno($seqno);
- my $has_list = $rhas_broken_container->{$seqno};
+ my $has_list = $rhas_broken_list->{$seqno};
# This must be a list (this will exclude all code blocks)
# or contain a list
my $nmax = @{$ri_right} - 1;
return unless ( $nmax >= 0 );
- my $rLL = $self->[_rLL_];
- my $ris_broken_container = $self->[_ris_broken_container_];
- my $rhas_broken_container = $self->[_rhas_broken_container_];
- my $rparent_of_seqno = $self->[_rparent_of_seqno_];
+ my $rLL = $self->[_rLL_];
my $rbreak_before_container_by_seqno =
$self->[_rbreak_before_container_by_seqno_];
&& $types_to_go[ $i - 1 ] eq 'b' )
);
- # Patch to avoid blinkes: but do not do this unless
+ # Patch to avoid blinkers: but do not do this unless
# line difference is > 1 (see case b977)
if ($ok) {
my $seqno = $type_sequence_to_go[$i_line_start];
- if ( $ris_broken_container->{$seqno} <= 1 ) {
+ if ( $ris_broken_container->{$seqno}
+ && $ris_broken_container->{$seqno} <= 1 )
+ {
$ok = 0;
}
}
my $rbreak_container = $self->[_rbreak_container_];
my $rshort_nested = $self->[_rshort_nested_];
my $rLL = $self->[_rLL_];
+ my $rbreak_before_container_by_seqno =
+ $self->[_rbreak_before_container_by_seqno_];
# find needed previous nonblank tokens
my $last_nonblank_token = '';
my $last_equals = $last_gnu_equals{$total_depth};
if ( $last_equals && $last_equals > $line_start_index_to_go ) {
+ my $seqno = $type_sequence_to_go[$max_index_to_go];
+
# find the position if we break at the '='
my $i_test = $last_equals;
if ( $types_to_go[ $i_test + 1 ] eq 'b' ) { $i_test++ }
total_line_length( $i_test, $max_index_to_go );
my $mll = $maximum_line_length[ $levels_to_go[$i_test] ];
+ my $bbc_flag = $break_before_container_types{$token};
+
if (
# the equals is not just before an open paren (testing)
$gnu_position_predictor >
$mll - $rOpts_maximum_line_length / 2
+ # if a -bbx flag WANTS a break before this opening token
+ || ( $seqno && $rbreak_before_container_by_seqno->{$seqno} )
+
+ # or if we MIGHT want a break (fixes case b826 b909 b989)
+ || ( $bbc_flag && $bbc_flag >= 2 )
+
# or we are beyond the 1/4 point and there was an old
# break at the equals
|| (
--- /dev/null
+# Created with: ./make_t.pl
+
+# Contents:
+#1 git54.def
+#2 git54.git54
+
+# To locate test #13 you can search for its name or the string '#13'
+
+use strict;
+use Test::More;
+use Carp;
+use Perl::Tidy;
+my $rparams;
+my $rsources;
+my $rtests;
+
+BEGIN {
+
+ ###########################################
+ # BEGIN SECTION 1: Parameter combinations #
+ ###########################################
+ $rparams = {
+ 'def' => "",
+ 'git54' => "-bbp=3 -bbpi=2 -ci=4 -lp",
+ };
+
+ ############################
+ # BEGIN SECTION 2: Sources #
+ ############################
+ $rsources = {
+
+ 'git54' => <<'----------',
+# testing sensitivity to excess commas
+my $definition =>
+ (
+ {
+ key1 => value1
+ },
+ {
+ key2 => value2
+ },
+ );
+
+my $definition =>
+ (
+ {
+ key => value
+ }
+ );
+
+my $definition =>
+ (
+ {
+ key => value
+ },
+ );
+
+my $definition =>
+ (
+ {
+ key => value,
+ },
+ );
+
+my $list =
+ (
+ {
+ key => $value,
+ key => $value,
+ key => $value,
+ key => $value,
+ key => $value,
+ },
+ ) ;
+
+my $list =
+ (
+ {
+ key => $value,
+ key => $value,
+ key => $value,
+ key => $value,
+ key => $value,
+ }
+ ) ;
+----------
+ };
+
+ ####################################
+ # BEGIN SECTION 3: Expected output #
+ ####################################
+ $rtests = {
+
+ 'git54.def' => {
+ source => "git54",
+ params => "def",
+ expect => <<'#1...........',
+# testing sensitivity to excess commas
+my $definition => (
+ {
+ key1 => value1
+ },
+ {
+ key2 => value2
+ },
+);
+
+my $definition => (
+ {
+ key => value
+ }
+);
+
+my $definition => (
+ {
+ key => value
+ },
+);
+
+my $definition => (
+ {
+ key => value,
+ },
+);
+
+my $list = (
+ {
+ key => $value,
+ key => $value,
+ key => $value,
+ key => $value,
+ key => $value,
+ },
+);
+
+my $list = (
+ {
+ key => $value,
+ key => $value,
+ key => $value,
+ key => $value,
+ key => $value,
+ }
+);
+#1...........
+ },
+
+ 'git54.git54' => {
+ source => "git54",
+ params => "git54",
+ expect => <<'#2...........',
+# testing sensitivity to excess commas
+my $definition =>
+ (
+ {
+ key1 => value1
+ },
+ {
+ key2 => value2
+ },
+ );
+
+my $definition =>
+ (
+ {
+ key => value
+ }
+ );
+
+my $definition =>
+ (
+ {
+ key => value
+ },
+ );
+
+my $definition =>
+ (
+ {
+ key => value,
+ },
+ );
+
+my $list =
+ (
+ {
+ key => $value,
+ key => $value,
+ key => $value,
+ key => $value,
+ key => $value,
+ },
+ );
+
+my $list =
+ (
+ {
+ key => $value,
+ key => $value,
+ key => $value,
+ key => $value,
+ key => $value,
+ }
+ );
+#2...........
+ },
+ };
+
+ my $ntests = 0 + keys %{$rtests};
+ plan tests => $ntests;
+}
+
+###############
+# EXECUTE TESTS
+###############
+
+foreach my $key ( sort keys %{$rtests} ) {
+ my $output;
+ my $sname = $rtests->{$key}->{source};
+ my $expect = $rtests->{$key}->{expect};
+ my $pname = $rtests->{$key}->{params};
+ my $source = $rsources->{$sname};
+ my $params = defined($pname) ? $rparams->{$pname} : "";
+ my $stderr_string;
+ my $errorfile_string;
+ my $err = Perl::Tidy::perltidy(
+ source => \$source,
+ destination => \$output,
+ perltidyrc => \$params,
+ argv => '', # for safety; hide any ARGV from perltidy
+ stderr => \$stderr_string,
+ errorfile => \$errorfile_string, # not used when -se flag is set
+ );
+ if ( $err || $stderr_string || $errorfile_string ) {
+ print STDERR "Error output received for test '$key'\n";
+ if ($err) {
+ print STDERR "An error flag '$err' was returned\n";
+ ok( !$err );
+ }
+ if ($stderr_string) {
+ print STDERR "---------------------\n";
+ print STDERR "<<STDERR>>\n$stderr_string\n";
+ print STDERR "---------------------\n";
+ ok( !$stderr_string );
+ }
+ if ($errorfile_string) {
+ print STDERR "---------------------\n";
+ print STDERR "<<.ERR file>>\n$errorfile_string\n";
+ print STDERR "---------------------\n";
+ ok( !$errorfile_string );
+ }
+ }
+ else {
+ if ( !is( $output, $expect, $key ) ) {
+ my $leno = length($output);
+ my $lene = length($expect);
+ if ( $leno == $lene ) {
+ print STDERR
+"#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
+ }
+ else {
+ print STDERR
+"#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";
+ }
+ }
+ }
+}
projects / perltidy.git / commitdiff