## 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.
$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
'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:
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
$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,
$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 =
my %flags = ();
my @list = split_words($str);
+ if ( DEBUG_KB && @list ) {
+ local $" = ' ';
+ print <<EOM;
+DEBUG_KB entering for '$short_name' with str=$str\n";
+list is: @list;
+EOM
+ }
+
+ # - pull out any any leading container code, like f( or *{
+ foreach (@list) {
+ if ( $_ =~ /^( [ \w\* ] )( [ \{\(\[\}\)\] ] )$/x ) {
+ $_ = $2;
+ $flags{$2} = $1;
+ }
+ }
- # - pull out any any leading container letter code, like 'f(
- map { s/^ ([\w\*]) ( [ [\{\(\[\}\)\] ] ) $/$2/x; $flags{$2} .= $1 if ($1) }
- @list;
+ #--------------------------------------------------------------------------
+ # FIXME: check @list for valid token types here. For example, a missing
+ # space like '=>,' would cause an error and be hard to find.
+ #--------------------------------------------------------------------------
@{$rkeep_break_hash}{@list} = (1) x scalar(@list);
if ( DEBUG_KB && @list ) {
my @tmp = %flags;
+ local $" = ' ';
print <<EOM;
DEBUG_KB -$short_name flag: $str
-final keys: @list
-special flags: @tmp
+final keys: @list
+special flags: @tmp
EOM
}
}
elsif ( $token eq '{' || $token eq '}' ) {
- # codes for brace types could be expanded in the future
+ # These tentative codes 'b' and 'B' for brace types are
+ # placeholders for possible future brace types. They
+ # are not documented and may be changed.
my $block_type =
$self->[_rblock_type_of_seqno_]->{$seqno};
if ( $flag eq 'b' ) { $match = $block_type }
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
|| $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
--- /dev/null
+{
+ L1:
+ L2:
+ L2: return;
+};
--- /dev/null
+{
+ L1:
+ L2:
+ L2:
+ return;
+};
--- /dev/null
+{
+ L1: L2: L2: return;
+};
--- /dev/null
+{
+ L1:
+ L2:
+ L2: return;
+};
../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
../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
#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'
# BEGIN SECTION 1: Parameter combinations #
###########################################
$rparams = {
+ 'bal1' => "-bal=1",
'braces8' => <<'----------',
-bl -bbvt=1 -blxl=' ' -bll='sub do asub'
----------
############################
$rsources = {
+ 'bal' => <<'----------',
+{
+ L1:
+ L2:
+ L2: return;
+};
+----------
+
'braces' => <<'----------',
sub message {
if ( !defined( $_[0] ) ) {
$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};
--- /dev/null
+# 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 "<<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