## 2022 11 12.04
+ - Added parameter --one-line-block-exclusion-list=s, or -olbxl=s, where
+ s is a list of block types which should not automatically be turned
+ into one-line blocks. This implements the issue raised in PR #111.
+ The list s may include any of the words 'sort map grep eval', or
+ it may be '*' to indicate all of these. So for example to prevent
+ multi-line 'eval' blocks from becomming one-line blocks, the command
+ would be -olbxl='eval'.
+
- For the -b (--backup-and-modify-in-place) option, the file timestamps
are changing (issue rt#145999). First, if there are no formatting
changes to an input file, it will keep its original modification time.
t/snippets25.t
t/snippets26.t
t/snippets27.t
+t/snippets28.t
t/snippets3.t
t/snippets4.t
t/snippets5.t
option is used) if the block is a code block.
The main exception is that perltidy will attempt to form new one-line
-blocks following the keywords C<map>, C<eval>, and C<sort>, because
+blocks following the keywords C<map>, C<eval>, and C<sort>, C<eval>, because
these code blocks are often small and most clearly displayed in a single
-line.
+line. This behavior can be controlled with the flag B<--one-line-block-exclusion-list> described below.
One-line block rules can conflict with the cuddled-else option. When
the cuddled-else option is used, perltidy retains existing one-line
This shows that blocks with a single statement become one-line blocks.
+=item B<-olbxl=s>, B<--one-line-block-exclusion-list=s>
+
+As noted above, perltidy will, by default, attempt to create new one-line
+blocks for certain block types. This flag allows the user to prevent this
+behavior for the block types listed in the string B<s>. The list B<s> may
+include any of the words C<sort>, C<map>, C<grep>, C<eval>, or it may be C<*>
+to indicate all of these.
+
+So for example to prevent multi-line 'eval' blocks from becomming one-line
+blocks, the command would be B<-olbxl='eval'>. In this case, existing one-line B<eval> blocks will remain on one-line if possible, and existing multi-line
+B<eval> blocks will remain multi-line blocks.
+
=item B<-olbs=n>, B<--one-line-block-semicolons=n>
This flag controls the placement of semicolons at the end of one-line blocks.
is a single line in the source, or it will be broken into multiple lines if it
is broken in multiple lines in the source.
-
=back
-
=head2 Controlling Vertical Alignment
Vertical alignment refers to lining up certain symbols in a list of consecutive
D anl asbl asc ast asu atc atnl aws b
baa baao bar bbao bbb bbc bbs bl bli boa
- boc bok bol bom bos bot cblx ce conv cs
- csc cscb cscw dac dbc dbs dcbl dcsc ddf dln
- dnl dop dp dpro drc dsc dsm dsn dtc dtt
- dwic dwls dwrs dws eos f fll fpva frm fs
- fso gcs hbc hbcm hbco hbh hbhh hbi hbj hbk
- hbm hbn hbp hbpd hbpu hbq hbs hbsc hbv hbw
- hent hic hicm hico hih hihh hii hij hik him
- hin hip hipd hipu hiq his hisc hiv hiw hsc
- html ibc icb icp iob isbc iscl kgb kgbd kgbi
- kis lal log lop lp lsl mem nib ohbr okw
- ola olc oll olq opr opt osbc osbr otr ple
- pod pvl q sac sbc sbl scbb schb scp scsb
- sct se sfp sfs skp sob sobb sohb sop sosb
- sot ssc st sts t tac tbc toc tp tqw
- trp ts tsc tso vbc vc vmll vsc w wfc
- wn x xci xlp xs
+ boc bok bol bom bos bot cblx ce conv cpb
+ cs csc cscb cscw dac dbc dbs dcbl dcsc ddf
+ dln dnl dop dp dpro drc dsc dsm dsn dtc
+ dtt dwic dwls dwrs dws eos f fll fpva frm
+ fs fso gcs hbc hbcm hbco hbh hbhh hbi hbj
+ hbk hbm hbn hbp hbpd hbpu hbq hbs hbsc hbv
+ hbw hent hic hicm hico hih hihh hii hij hik
+ him hin hip hipd hipu hiq his hisc hiv hiw
+ hsc html ibc icb icp iob isbc iscl kgb kgbd
+ kgbi kis lal log lop lp lsl mem nib ohbr
+ okw ola olc oll olq opr opt osbc osbr otr
+ ple pod pvl q sac sbc sbl scbb schb scp
+ scsb sct se sfp sfs skp sob sobb sohb sop
+ sosb sot ssc st sts t tac tbc toc tp
+ tqw trp ts tsc tso vbc vc vmll vsc w
+ wfc wn x xci xlp xs
Equivalently, the prefix 'no' or 'no-' on the corresponding long names may be
used.
'break-after-labels' => [ 0, 2 ],
'want-trailing-commas' => [ '0', '*', 'm', 'b', 'h', 'i', ' ' ],
+ 'one-line-block-exclusion-list' =>
+ [ 'sort', 'map', 'grep', 'eval', '*', 'zzyzx' ],
'use-feature' => [ 'class', ' ', 'xyzzy' ],
$add_option->( 'keep-interior-semicolons', 'kis', '!' );
$add_option->( 'one-line-block-semicolons', 'olbs', '=i' );
$add_option->( 'one-line-block-nesting', 'olbn', '=i' );
+ $add_option->( 'one-line-block-exclusion-list', 'olbxl', '=s' );
$add_option->( 'break-before-hash-brace', 'bbhb', '=i' );
$add_option->( 'break-before-hash-brace-and-indent', 'bbhbi', '=i' );
$add_option->( 'break-before-square-bracket', 'bbsb', '=i' );
initialize_bond_strength_hashes();
# This function must be called early to get hashes with grep initialized
- initialize_grep_and_friends( $rOpts->{'grep-alias-list'} );
+ initialize_grep_and_friends();
# Make needed regex patterns for matching text.
# NOTE: sub_matching_patterns must be made first because later patterns use
make_blank_line_pattern();
make_keyword_group_list_pattern();
- # Make initial list of desired one line block types
- # They will be modified by 'prepare_cuddled_block_types'
- # NOTE: this line must come after is_sort_map_grep_eval is
- # initialized in sub 'initialize_grep_and_friends'
- %want_one_line_block = %is_sort_map_grep_eval;
-
prepare_cuddled_block_types();
if ( $rOpts->{'dump-cuddled-block-list'} ) {
dump_cuddled_block_list(*STDOUT);
use constant ALIGN_GREP_ALIASES => 0;
sub initialize_grep_and_friends {
- my ($str) = @_;
# Initialize or re-initialize hashes with 'grep' and grep aliases. This
# must be done after each set of options because new grep aliases may be
# used.
- # re-initialize the hash ... this is critical!
+ # re-initialize the hashes ... this is critical!
%is_sort_map_grep = ();
my @q = qw(sort map grep);
@is_sort_map_grep{@q} = (1) x scalar(@q);
+ my $olbxl = $rOpts->{'one-line-block-exclusion-list'};
+ my %is_olb_exclusion_word;
+ if ( defined($olbxl) ) {
+ my @list = split_words($olbxl);
+ if (@list) {
+ @is_olb_exclusion_word{@list} = (1) x scalar(@list);
+ }
+ }
+
+ # Make the list of block types which may be re-formed into one line.
+ # They will be modified with the grep-alias-list below and
+ # by sub 'prepare_cuddled_block_types'.
+ # Note that it is essential to always re-initialize the hash here:
+ %want_one_line_block = ();
+ if ( !$is_olb_exclusion_word{'*'} ) {
+ foreach (qw(sort map grep eval)) {
+ if ( !$is_olb_exclusion_word{$_} ) { $want_one_line_block{$_} = 1 }
+ }
+ }
+
# Note that any 'grep-alias-list' string has been preprocessed to be a
# trimmed, space-separated list.
+ my $str = $rOpts->{'grep-alias-list'};
my @grep_aliases = split /\s+/, $str;
- @{is_sort_map_grep}{@grep_aliases} = (1) x scalar(@grep_aliases);
+
+ if (@grep_aliases) {
+
+ @{is_sort_map_grep}{@grep_aliases} = (1) x scalar(@grep_aliases);
+
+ if ( $want_one_line_block{'grep'} ) {
+ @{want_one_line_block}{@grep_aliases} = (1) x scalar(@grep_aliases);
+ }
+ }
##@q = qw(sort map grep eval);
%is_sort_map_grep_eval = %is_sort_map_grep;
--- /dev/null
+ eval { require Ace };
+
+ @list =
+ map { $frm{ ( /@(.*?)>/ ? $1 : $_ ) }++ ? () : ($_); } @list;
+
+ $color = join( '/',
+ sort { $color_value{$::a} <=> $color_value{$::b}; }
+ keys %colors );
+
+ @sorted =
+ sort { $SortDir * $PageTotal{$a} <=> $SortDir * $PageTotal{$b} };
--- /dev/null
+ eval {
+ require Ace;
+ };
+
+ @list =
+ map { $frm{ ( /@(.*?)>/ ? $1 : $_ ) }++ ? () : ($_); } @list;
+
+ $color = join( '/',
+ sort { $color_value{$::a} <=> $color_value{$::b}; }
+ keys %colors );
+
+ @sorted =
+ sort { $SortDir * $PageTotal{$a} <=> $SortDir * $PageTotal{$b} };
--- /dev/null
+ eval {
+ require Ace;
+ };
+
+ @list = map {
+ $frm{ ( /@(.*?)>/ ? $1 : $_ ) }++ ? () : ($_);
+ } @list;
+
+ $color = join(
+ '/',
+ sort {
+ $color_value{$::a} <=> $color_value{$::b};
+ } keys %colors
+ );
+
+ @sorted = sort {
+ $SortDir * $PageTotal{$a} <=> $SortDir * $PageTotal{$b}
+ };
--- /dev/null
+ eval {
+ require Ace };
+
+ @list = map {
+ $frm{ ( /@(.*?)>/ ? $1 : $_ ) }++ ? () : ($_);
+ } @list;
+
+ $color = join(
+ '/',
+ sort {
+ $color_value{$::a} <=> $color_value{$::b};
+ } keys %colors
+ );
+
+ @sorted = sort {
+ $SortDir * $PageTotal{$a} <=> $SortDir * $PageTotal{$b}
+ };
--- /dev/null
+-olbxl=eval
--- /dev/null
+-olbxl='*'
../snippets9.t rt98902.def
../snippets9.t rt98902.rt98902
../snippets9.t rt99961.def
+../snippets27.t olbxl.def
+../snippets27.t olbxl.olbxl1
+../snippets28.t olbxl.olbxl2
#15 cpb.cpb
#16 cpb.def
#17 rt145706.def
+#18 olbxl.def
+#19 olbxl.olbxl1
# To locate test #13 you can search for its name or the string '#13'
'cpb' => "-cpb",
'def' => "",
'dwic' => "-wn -dwic",
+ 'olbxl1' => "-olbxl=eval",
'rt144979' => "-xci -ce -lp",
'wtc1' => "-wtc=0 -dtc",
'wtc2' => "-wtc=1 -atc",
);
----------
+ 'olbxl' => <<'----------',
+ eval {
+ require Ace };
+
+ @list = map {
+ $frm{ ( /@(.*?)>/ ? $1 : $_ ) }++ ? () : ($_);
+ } @list;
+
+ $color = join(
+ '/',
+ sort {
+ $color_value{$::a} <=> $color_value{$::b};
+ } keys %colors
+ );
+
+ @sorted = sort {
+ $SortDir * $PageTotal{$a} <=> $SortDir * $PageTotal{$b}
+ };
+----------
+
'rt144979' => <<'----------',
# part 1
GetOptions(
my $x = field(50);
#17...........
},
+
+ 'olbxl.def' => {
+ source => "olbxl",
+ params => "def",
+ expect => <<'#18...........',
+ eval { require Ace };
+
+ @list =
+ map { $frm{ ( /@(.*?)>/ ? $1 : $_ ) }++ ? () : ($_); } @list;
+
+ $color = join( '/',
+ sort { $color_value{$::a} <=> $color_value{$::b}; }
+ keys %colors );
+
+ @sorted =
+ sort { $SortDir * $PageTotal{$a} <=> $SortDir * $PageTotal{$b} };
+#18...........
+ },
+
+ 'olbxl.olbxl1' => {
+ source => "olbxl",
+ params => "olbxl1",
+ expect => <<'#19...........',
+ eval {
+ require Ace;
+ };
+
+ @list =
+ map { $frm{ ( /@(.*?)>/ ? $1 : $_ ) }++ ? () : ($_); } @list;
+
+ $color = join( '/',
+ sort { $color_value{$::a} <=> $color_value{$::b}; }
+ keys %colors );
+
+ @sorted =
+ sort { $SortDir * $PageTotal{$a} <=> $SortDir * $PageTotal{$b} };
+#19...........
+ },
};
my $ntests = 0 + keys %{$rtests};
--- /dev/null
+# Created with: ./make_t.pl
+
+# Contents:
+#1 olbxl.olbxl2
+
+# 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 = {
+ 'olbxl2' => <<'----------',
+-olbxl='*'
+----------
+ };
+
+ ############################
+ # BEGIN SECTION 2: Sources #
+ ############################
+ $rsources = {
+
+ 'olbxl' => <<'----------',
+ eval {
+ require Ace };
+
+ @list = map {
+ $frm{ ( /@(.*?)>/ ? $1 : $_ ) }++ ? () : ($_);
+ } @list;
+
+ $color = join(
+ '/',
+ sort {
+ $color_value{$::a} <=> $color_value{$::b};
+ } keys %colors
+ );
+
+ @sorted = sort {
+ $SortDir * $PageTotal{$a} <=> $SortDir * $PageTotal{$b}
+ };
+----------
+ };
+
+ ####################################
+ # BEGIN SECTION 3: Expected output #
+ ####################################
+ $rtests = {
+
+ 'olbxl.olbxl2' => {
+ source => "olbxl",
+ params => "olbxl2",
+ expect => <<'#1...........',
+ eval {
+ require Ace;
+ };
+
+ @list = map {
+ $frm{ ( /@(.*?)>/ ? $1 : $_ ) }++ ? () : ($_);
+ } @list;
+
+ $color = join(
+ '/',
+ sort {
+ $color_value{$::a} <=> $color_value{$::b};
+ } keys %colors
+ );
+
+ @sorted = sort {
+ $SortDir * $PageTotal{$a} <=> $SortDir * $PageTotal{$b}
+ };
+#1...........
+ },
+ };
+
+ 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