From: Steve Hancock Date: Fri, 28 Jan 2022 15:14:42 +0000 (-0800) Subject: add --break-after-labels=i, or -bal=i, for git #86 X-Git-Tag: 20211029.06~9 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=7d9282bc3c24a0a58e87109c206820c7b223bdb8;p=perltidy.git add --break-after-labels=i, or -bal=i, for git #86 --- diff --git a/CHANGES.md b/CHANGES.md index 9ac5a6f9..cbb40a24 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,39 @@ ## 2021 10 29.05 + - A new flag --break-after-labels=i, or -bal=i, was added as requested + in git #86. This controls line breaks after labels, as follows: + + -bal=0 follows the input line breaks [DEFAULT] + -bal=1 always break after a label + -bal=2 never break after a label + + So for example, for the following input + + INIT: { + $xx = 1.234; + } + + # perltidy -bal=1 + INIT: + { + $xx = 1.234; + } + + - A new flag, --encode-output-strings, or -eos, has been added to resolve + issue git #83. This issue involves the interface between Perl::Tidy and + calling programs, and tidyall in particular. If you use tidyall and have + encoded files you may want to set this flag. The crux of the matter is + that by default perltidy returns unencoded strings to the calling program. + Some programs need encoded strings, and setting this flag causes encoding. + If you use tidyall with encoded files (like utf8) you should probably + set this flag. If you run the perltidy binary this flag has no effect. + + - The flags -kbb=s or --keep-old-breakpoints-before=s, and its counterpart + -kba=s or --keep-old-breakpoints-after=s have expanded functionality + for the container tokens { [ ( and } ] ). See the updated man pages for + details. + - Two new flags have been added to provide finer vertical alignment control, --valign-exclusion-list=s (-vxl=s) and --valign-inclusion-list=s (-vil=s). This has been requested several times, recently in git #79. diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index 1dcc9320..22af8aeb 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -2462,7 +2462,12 @@ sub generate_options { $add_option->( 'break-before-paren-and-indent', 'bbpi', '=i' ); $add_option->( 'brace-left-list', 'bll', '=s' ); $add_option->( 'brace-left-exclusion-list', 'blxl', '=s' ); - $add_option->( 'break-open-paren-list', 'bopl', '=s' ); + $add_option->( 'break-after-labels', 'bal', '=i' ); + + ## This was an experiment mentioned in git #78. It works, but it does not + ## look very useful. Instead, I expanded the functionality of the + ## --keep-old-breakpoint-xxx flags. + ##$add_option->( 'break-open-paren-list', 'bopl', '=s' ); ######################################## $category = 6; # Controlling list formatting @@ -2619,6 +2624,7 @@ sub generate_options { 'keyword-group-blanks-after' => [ 0, 2 ], 'space-prototype-paren' => [ 0, 2 ], + 'break-after-labels' => [ 0, 2 ], ); # Note: we could actually allow negative ci if someone really wants it: @@ -2651,6 +2657,7 @@ sub generate_options { brace-tightness=1 brace-vertical-tightness-closing=0 brace-vertical-tightness=0 + break-after-labels=0 break-at-old-logical-breakpoints break-at-old-ternary-breakpoints break-at-old-attribute-breakpoints diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index f3a65c9f..57071652 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -144,6 +144,7 @@ my ( $rOpts_blank_lines_after_opening_block, $rOpts_block_brace_tightness, $rOpts_block_brace_vertical_tightness, + $rOpts_break_after_labels, $rOpts_break_at_old_attribute_breakpoints, $rOpts_break_at_old_comma_breakpoints, $rOpts_break_at_old_keyword_breakpoints, @@ -1727,6 +1728,7 @@ EOM $rOpts_block_brace_tightness = $rOpts->{'block-brace-tightness'}; $rOpts_block_brace_vertical_tightness = $rOpts->{'block-brace-vertical-tightness'}; + $rOpts_break_after_labels = $rOpts->{'break-after-labels'}; $rOpts_break_at_old_attribute_breakpoints = $rOpts->{'break-at-old-attribute-breakpoints'}; $rOpts_break_at_old_comma_breakpoints = @@ -2254,10 +2256,26 @@ sub initialize_keep_old_breakpoints { my %flags = (); my @list = split_words($str); + if ( DEBUG_KB && @list ) { + local $" = ' '; + print <,' would cause an error and be hard to find. + #-------------------------------------------------------------------------- @{$rkeep_break_hash}{@list} = (1) x scalar(@list); @@ -2323,11 +2341,12 @@ EOM if ( DEBUG_KB && @list ) { my @tmp = %flags; + local $" = ' '; print <[_rblock_type_of_seqno_]->{$seqno}; if ( $flag eq 'b' ) { $match = $block_type } @@ -13172,6 +13193,12 @@ EOM else { $self->store_token_to_go( $Ktoken_vars, $rtoken_vars ); + + # break after a label if requested + if ( $type eq 'J' && $rOpts_break_after_labels == 1 ) { + $self->end_batch() + unless ($no_internal_newlines); + } } # remember two previous nonblank, non-comment OUTPUT tokens @@ -13198,7 +13225,7 @@ EOM || $is_VERSION_statement # to keep a label at the end of a line - || $type eq 'J' + || ( $type eq 'J' && $rOpts_break_after_labels != 2 ) # if we have a hard break request || $break_flag && $break_flag != 2 diff --git a/t/snippets/bal.in b/t/snippets/bal.in new file mode 100644 index 00000000..9f266d71 --- /dev/null +++ b/t/snippets/bal.in @@ -0,0 +1,5 @@ +{ + L1: + L2: + L2: return; +}; diff --git a/t/snippets/bal1.par b/t/snippets/bal1.par new file mode 100644 index 00000000..a413ecc7 --- /dev/null +++ b/t/snippets/bal1.par @@ -0,0 +1 @@ +-bal=1 diff --git a/t/snippets/bal2.par b/t/snippets/bal2.par new file mode 100644 index 00000000..1adb5d9e --- /dev/null +++ b/t/snippets/bal2.par @@ -0,0 +1 @@ +-bal=2 diff --git a/t/snippets/expect/bal.bal1 b/t/snippets/expect/bal.bal1 new file mode 100644 index 00000000..cbc04407 --- /dev/null +++ b/t/snippets/expect/bal.bal1 @@ -0,0 +1,6 @@ +{ + L1: + L2: + L2: + return; +}; diff --git a/t/snippets/expect/bal.bal2 b/t/snippets/expect/bal.bal2 new file mode 100644 index 00000000..b9f32e3e --- /dev/null +++ b/t/snippets/expect/bal.bal2 @@ -0,0 +1,3 @@ +{ + L1: L2: L2: return; +}; diff --git a/t/snippets/expect/bal.def b/t/snippets/expect/bal.def new file mode 100644 index 00000000..9f266d71 --- /dev/null +++ b/t/snippets/expect/bal.def @@ -0,0 +1,5 @@ +{ + L1: + L2: + L2: return; +}; diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt index 2aa01294..774a5880 100644 --- a/t/snippets/packing_list.txt +++ b/t/snippets/packing_list.txt @@ -342,6 +342,9 @@ ../snippets25.t git74.git74 ../snippets25.t git77.def ../snippets25.t git77.git77 +../snippets25.t vxl.def +../snippets25.t vxl.vxl1 +../snippets25.t vxl.vxl2 ../snippets3.t ce_wn1.ce_wn ../snippets3.t ce_wn1.def ../snippets3.t colin.colin @@ -482,6 +485,6 @@ ../snippets9.t rt98902.def ../snippets9.t rt98902.rt98902 ../snippets9.t rt99961.def -../snippets25.t vxl.def -../snippets25.t vxl.vxl1 -../snippets25.t vxl.vxl2 +../snippets25.t bal.bal1 +../snippets26.t bal.bal2 +../snippets26.t bal.def diff --git a/t/snippets25.t b/t/snippets25.t index 38ba5de0..8c568163 100644 --- a/t/snippets25.t +++ b/t/snippets25.t @@ -19,6 +19,7 @@ #16 vxl.def #17 vxl.vxl1 #18 vxl.vxl2 +#19 bal.bal1 # To locate test #13 you can search for its name or the string '#13' @@ -36,6 +37,7 @@ BEGIN { # BEGIN SECTION 1: Parameter combinations # ########################################### $rparams = { + 'bal1' => "-bal=1", 'braces8' => <<'----------', -bl -bbvt=1 -blxl=' ' -bll='sub do asub' ---------- @@ -81,6 +83,14 @@ BEGIN { ############################ $rsources = { + 'bal' => <<'----------', +{ + L1: + L2: + L2: return; +}; +---------- + 'braces' => <<'----------', sub message { if ( !defined( $_[0] ) ) { @@ -759,6 +769,19 @@ $co_prompt = ($color) ? 'bold green' : ''; # prompt $co_unused = ($color) ? 'on_green' : 'reverse'; # unused #18........... }, + + 'bal.bal1' => { + source => "bal", + params => "bal1", + expect => <<'#19...........', +{ + L1: + L2: + L2: + return; +}; +#19........... + }, }; my $ntests = 0 + keys %{$rtests}; diff --git a/t/snippets26.t b/t/snippets26.t new file mode 100644 index 00000000..7869dfeb --- /dev/null +++ b/t/snippets26.t @@ -0,0 +1,127 @@ +# Created with: ./make_t.pl + +# Contents: +#1 bal.bal2 +#2 bal.def + +# 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 = { + 'bal2' => "-bal=2", + 'def' => "", + }; + + ############################ + # BEGIN SECTION 2: Sources # + ############################ + $rsources = { + + 'bal' => <<'----------', +{ + L1: + L2: + L2: return; +}; +---------- + }; + + #################################### + # BEGIN SECTION 3: Expected output # + #################################### + $rtests = { + + 'bal.bal2' => { + source => "bal", + params => "bal2", + expect => <<'#1...........', +{ + L1: L2: L2: return; +}; +#1........... + }, + + 'bal.def' => { + source => "bal", + params => "def", + expect => <<'#2...........', +{ + L1: + L2: + L2: return; +}; +#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 "<>\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"; + } + } + } +}