From: Steve Hancock Date: Tue, 21 Dec 2021 13:42:39 +0000 (-0800) Subject: initial implementation of -gal=s, issue git #77 X-Git-Tag: 20211029.04~2 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=34bfd18d021591e4599a2ac11d5d0bf8130e9321;p=perltidy.git initial implementation of -gal=s, issue git #77 --- diff --git a/CHANGES.md b/CHANGES.md index 744f93f8..f8d392fd 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,10 @@ ## 2021 10 29.03 + - A new flag -gal=s, --grep-alias-list=s, has been added as suggested in + git #77. This allows code blocks passed to list operator functions to + be formatted in the same way as a code block passed to grep, map, or sort. + - A new flag -xlp has been added which can be set to avoid most of the limitations of the -lp flag regarding side comments, blank lines, and code blocks. This is off by default to avoid changing existing coding, diff --git a/bin/perltidy b/bin/perltidy index a0743514..0370ffe8 100755 --- a/bin/perltidy +++ b/bin/perltidy @@ -390,6 +390,16 @@ will cause the perltidy to treate the words 'method', 'fun', '_sub' and 'M4' to Note that several other parameters accept a list of keywords, including 'sub' (see L). You do not need to include any sub aliases in these lists. Just include keyword 'sub' if you wish, and all aliases are automatically included. +=item B<-gal=s>, B<--grep-alias-list=s> + +This flag causes a code block following a specified word to be formatted as if it followed the keyword 'grep'. The string B contains one or more such alias words, separated by spaces or commas. + +This allows code block arguments to external list operator functions to be formatted in the same way as code blocks which follow the perl builtin keywords 'grep', 'map', and 'sort'. Perltidy tries to keep code blocks for these functions intact, and does not automatically break after the closing brace since a list may follow. + +For example, the functions 'any' and 'all' in module List::Util can be given formatting like 'grep' with + + perltidy -gal='any all' + =back =head1 FORMATTING OPTIONS diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index 0615f2e8..f4a90e43 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -2256,6 +2256,7 @@ sub generate_options { $add_option->( 'assert-tidy', 'ast', '!' ); $add_option->( 'assert-untidy', 'asu', '!' ); $add_option->( 'sub-alias-list', 'sal', '=s' ); + $add_option->( 'grep-alias-list', 'gal', '=s' ); ######################################## $category = 2; # Code indentation control @@ -3379,6 +3380,30 @@ EOM $rOpts->{'sub-alias-list'} = join ' ', @filtered_word_list; } + if ( $rOpts->{'grep-alias-list'} ) { + my $grep_alias_string = $rOpts->{'grep-alias-list'}; + $grep_alias_string =~ s/,/ /g; # allow commas + $grep_alias_string =~ s/^\s+//; + $grep_alias_string =~ s/\s+$//; + my @grep_alias_list = split /\s+/, $grep_alias_string; + my @filtered_word_list; + my %seen; + + foreach my $word (@grep_alias_list) { + if ($word) { + if ( $word !~ /^\w[\w\d]*$/ ) { + Warn("unexpected grep alias '$word' - ignoring\n"); + } + if ( !$seen{$word} ) { + $seen{$word}++; + push @filtered_word_list, $word; + } + } + } + my $joined_words = join ' ', @filtered_word_list; + $rOpts->{'grep-alias-list'} = join ' ', @filtered_word_list; + } + # Turn on fuzzy-line-length unless this is an extrude run, as determined # by the -i and -ci settings. Otherwise blinkers can form (case b935) if ( !$rOpts->{'fuzzy-line-length'} ) { diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index b102b9a3..66e41ee0 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -205,6 +205,8 @@ my ( %is_last_next_redo_return, %is_sort_map_grep, %is_sort_map_grep_eval, + %is_sort_map_grep_eval_do, + %block_type_map, %is_if_unless, %is_and_or, %is_chain_operator, @@ -581,6 +583,22 @@ BEGIN { @q = qw(sort map grep eval); @is_sort_map_grep_eval{@q} = (1) x scalar(@q); + @q = qw(sort map grep eval do); + @is_sort_map_grep_eval_do{@q} = (1) x scalar(@q); + + # Map related block names into a common name to allow vertical alignment + # used by sub make_alignment_patterns + %block_type_map = ( + 'unless' => 'if', + 'else' => 'if', + 'elsif' => 'if', + 'when' => 'if', + 'default' => 'if', + 'case' => 'if', + 'sort' => 'map', + 'grep' => 'map', + ); + @q = qw(if unless); @is_if_unless{@q} = (1) x scalar(@q); @@ -1208,6 +1226,7 @@ sub check_options { initialize_whitespace_hashes(); initialize_bond_strength_hashes(); + install_grep_alias_list( $rOpts->{'grep-alias-list'} ); # Make needed regex patterns for matching text. # NOTE: sub_matching_patterns must be made first because later patterns use @@ -1929,6 +1948,23 @@ EOM return; } +sub install_grep_alias_list { + my ($str) = @_; + return unless ($str); + + # Note that any 'grep-alias-list' string has been preprocessed to be a + # trimmed, space-separated list. + my @q = split /\s+/, $str; + @{is_sort_map_grep}{@q} = (1) x scalar(@q); + @{is_sort_map_grep_eval}{@q} = (1) x scalar(@q); + @{is_sort_map_grep_eval_do}{@q} = (1) x scalar(@q); + @{is_block_with_ci}{@q} = (1) x scalar(@q); + @{is_keyword_returning_list}{@q} = (1) x scalar(@q); + foreach (@q) { + $block_type_map{$_} = 'map' unless ( $_ eq 'map' ); + } +} + sub initialize_weld_nested_exclusion_rules { my ($rOpts) = @_; %weld_nested_exclusion_rules = (); @@ -2903,8 +2939,6 @@ EOM BEGIN { my @q; - @q = qw(sort grep map); - @is_sort_grep_map{@q} = (1) x scalar(@q); @q = qw(for foreach); @is_for_foreach{@q} = (1) x scalar(@q); @@ -3138,7 +3172,7 @@ EOM ## || $typel eq 'Y' # must have space between grep and left paren; "grep(" will fail - || $is_sort_grep_map{$tokenl} + || $is_sort_map_grep{$tokenl} # don't stick numbers next to left parens, as in: #use Mail::Internet 1.28 (); (see Entity.pm, Head.pm, Test.pm) @@ -14358,62 +14392,51 @@ EOM return ( $rindentation_list->[ $nline + 1 ], $offset, $is_leading ); } -{ ## begin closure terminal_type_i +sub terminal_type_i { - my %is_sort_map_grep_eval_do; + # returns type of last token on this line (terminal token), as follows: + # returns # for a full-line comment + # returns ' ' for a blank line + # otherwise returns final token type - BEGIN { - my @q = qw(sort map grep eval do); - @is_sort_map_grep_eval_do{@q} = (1) x scalar(@q); - } - - sub terminal_type_i { - - # returns type of last token on this line (terminal token), as follows: - # returns # for a full-line comment - # returns ' ' for a blank line - # otherwise returns final token type - - my ( $ibeg, $iend ) = @_; + my ( $ibeg, $iend ) = @_; - # Start at the end and work backwards - my $i = $iend; - my $type_i = $types_to_go[$i]; + # Start at the end and work backwards + my $i = $iend; + my $type_i = $types_to_go[$i]; - # Check for side comment - if ( $type_i eq '#' ) { - $i--; - if ( $i < $ibeg ) { - return wantarray ? ( $type_i, $ibeg ) : $type_i; - } - $type_i = $types_to_go[$i]; - } - - # Skip past a blank - if ( $type_i eq 'b' ) { - $i--; - if ( $i < $ibeg ) { - return wantarray ? ( $type_i, $ibeg ) : $type_i; - } - $type_i = $types_to_go[$i]; + # Check for side comment + if ( $type_i eq '#' ) { + $i--; + if ( $i < $ibeg ) { + return wantarray ? ( $type_i, $ibeg ) : $type_i; } + $type_i = $types_to_go[$i]; + } - # Found it..make sure it is a BLOCK termination, - # but hide a terminal } after sort/grep/map because it is not - # necessarily the end of the line. (terminal.t) - my $block_type = $block_type_to_go[$i]; - if ( - $type_i eq '}' - && ( !$block_type - || ( $is_sort_map_grep_eval_do{$block_type} ) ) - ) - { - $type_i = 'b'; + # Skip past a blank + if ( $type_i eq 'b' ) { + $i--; + if ( $i < $ibeg ) { + return wantarray ? ( $type_i, $ibeg ) : $type_i; } - return wantarray ? ( $type_i, $i ) : $type_i; + $type_i = $types_to_go[$i]; } -} ## end closure terminal_type_i + # Found it..make sure it is a BLOCK termination, + # but hide a terminal } after sort/map/grep/eval/do because it is not + # necessarily the end of the line. (terminal.t) + my $block_type = $block_type_to_go[$i]; + if ( + $type_i eq '}' + && ( !$block_type + || ( $is_sort_map_grep_eval_do{$block_type} ) ) + ) + { + $type_i = 'b'; + } + return wantarray ? ( $type_i, $i ) : $type_i; +} sub pad_array_to_go { @@ -22993,7 +23016,6 @@ sub pad_token { { ## begin closure make_alignment_patterns - my %block_type_map; my %keyword_map; my %operator_map; my %is_w_n_C; @@ -23006,18 +23028,7 @@ sub pad_token { BEGIN { - # map related block names into a common name to - # allow alignment - %block_type_map = ( - 'unless' => 'if', - 'else' => 'if', - 'elsif' => 'if', - 'when' => 'if', - 'default' => 'if', - 'case' => 'if', - 'sort' => 'map', - 'grep' => 'map', - ); + # Note: %block_type_map is now global to enable the -gal=s option # map certain keywords to the same 'if' class to align # long if/elsif sequences. [elsif.pl] diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm index 9229a0a0..c354ff23 100644 --- a/lib/Perl/Tidy/Tokenizer.pm +++ b/lib/Perl/Tidy/Tokenizer.pm @@ -92,6 +92,8 @@ use vars qw{ %is_valid_token_type %is_keyword %is_code_block_token + %is_sort_map_grep_eval_do + %is_grep_alias %really_want_term @opening_brace_names @closing_brace_names @@ -310,6 +312,17 @@ sub check_options { } } + # Install any aliases to 'grep' + if ( $rOpts->{'grep-alias-list'} ) { + + # Note that 'grep-alias-list' has been preprocessed to be a trimmed, + # space-separated list + my @q = split /\s+/, $rOpts->{'grep-alias-list'}; + @{is_grep_alias}{@q} = (1) x scalar(@q); + @{is_code_block_token}{@q} = (1) x scalar(@q); + @{is_sort_map_grep_eval_do}{@q} = (1) x scalar(@q); + } + $rOpts_code_skipping = $rOpts->{'code-skipping'}; $code_skipping_pattern_begin = make_code_skipping_pattern( $rOpts, 'code-skipping-begin', '#<= 0 ) { if ( $routput_token_type->[$last_nonblank_i] eq 'w' ) { - $routput_token_type->[$last_nonblank_i] = 'G'; + $routput_token_type->[$last_nonblank_i] = + $is_grep_alias{$block_type} ? 'k' : 'G'; } } @@ -3201,10 +3215,6 @@ EOM if elsif else unless while until for foreach switch case given when); @is_zero_continuation_block_type{@_} = (1) x scalar(@_); - my %is_not_zero_continuation_block_type; - @_ = qw(sort grep map do eval); - @is_not_zero_continuation_block_type{@_} = (1) x scalar(@_); - my %is_logical_container; @_ = qw(if elsif unless while and or err not && ! || for foreach); @is_logical_container{@_} = (1) x scalar(@_); @@ -4988,7 +4998,7 @@ EOM # ..but these are not terminal types: # /^(sort|grep|map|do|eval)$/ ) elsif ( - $is_not_zero_continuation_block_type{ + $is_sort_map_grep_eval_do{ $routput_block_type->[$i] } ) @@ -9248,6 +9258,13 @@ BEGIN { switch case given when default catch try finally); @is_code_block_token{@q} = (1) x scalar(@q); + # Note: this hash was formerly named '%is_not_zero_continuation_block_type' + # to contrast it with the block types in '%is_zero_continuation_block_type' + @q = qw( sort map grep eval do ); + @is_sort_map_grep_eval_do{@q} = (1) x scalar(@q); + + %is_grep_alias = (); + # I'll build the list of keywords incrementally my @Keywords = (); @@ -9810,3 +9827,4 @@ BEGIN { @is_keyword{@Keywords} = (1) x scalar(@Keywords); } +1; diff --git a/t/snippets/expect/git77.def b/t/snippets/expect/git77.def new file mode 100644 index 00000000..75059486 --- /dev/null +++ b/t/snippets/expect/git77.def @@ -0,0 +1,16 @@ + # These should format the same with -gal='Map Grep' + return +{ + Map { + $_->init_arg => $_->get_value($instance) + } Grep { $_->has_value($instance) } + Grep { + defined( $_->init_arg ) + } + $class->get_all_attributes + }; + + return +{ + map { $_->init_arg => $_->get_value($instance) } + grep { $_->has_value($instance) } + grep { defined( $_->init_arg ) } $class->get_all_attributes + }; diff --git a/t/snippets/expect/git77.git77 b/t/snippets/expect/git77.git77 new file mode 100644 index 00000000..a5b982be --- /dev/null +++ b/t/snippets/expect/git77.git77 @@ -0,0 +1,12 @@ + # These should format the same with -gal='Map Grep' + return +{ + Map { $_->init_arg => $_->get_value($instance) } + Grep { $_->has_value($instance) } + Grep { defined( $_->init_arg ) } $class->get_all_attributes + }; + + return +{ + map { $_->init_arg => $_->get_value($instance) } + grep { $_->has_value($instance) } + grep { defined( $_->init_arg ) } $class->get_all_attributes + }; diff --git a/t/snippets/git77.in b/t/snippets/git77.in new file mode 100644 index 00000000..cbff9d57 --- /dev/null +++ b/t/snippets/git77.in @@ -0,0 +1,18 @@ +# These should format the same with -gal='Map Grep' + return +{ + Map { +$_->init_arg => $_->get_value($instance) } + Grep { $_->has_value($instance) } + Grep { +defined( $_->init_arg ) } +$class->get_all_attributes + }; + + return +{ + map { +$_->init_arg => $_->get_value($instance) } + grep { $_->has_value($instance) } + grep { +defined( $_->init_arg ) } +$class->get_all_attributes + }; diff --git a/t/snippets/git77.par b/t/snippets/git77.par new file mode 100644 index 00000000..8cd6a836 --- /dev/null +++ b/t/snippets/git77.par @@ -0,0 +1 @@ +-gal='Grep Map' diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt index 87dbc4e1..d944aba8 100644 --- a/t/snippets/packing_list.txt +++ b/t/snippets/packing_list.txt @@ -480,3 +480,5 @@ ../snippets9.t rt98902.def ../snippets9.t rt98902.rt98902 ../snippets9.t rt99961.def +../snippets25.t git77.def +../snippets25.t git77.git77 diff --git a/t/snippets25.t b/t/snippets25.t index 7502a927..8f0b09fd 100644 --- a/t/snippets25.t +++ b/t/snippets25.t @@ -14,6 +14,8 @@ #11 xlp1.xlp1 #12 git74.def #13 git74.git74 +#14 git77.def +#15 git77.git77 # To locate test #13 you can search for its name or the string '#13' @@ -53,6 +55,9 @@ BEGIN { --brace-left-and-indent --brace-left-and-indent-list="*" --break-before-hash-brace=3 +---------- + 'git77' => <<'----------', +-gal='Grep Map' ---------- 'lp' => "-lp", 'novalign1' => "-novalign", @@ -172,6 +177,27 @@ my $test_var = ); +---------- + + 'git77' => <<'----------', +# These should format the same with -gal='Map Grep' + return +{ + Map { +$_->init_arg => $_->get_value($instance) } + Grep { $_->has_value($instance) } + Grep { +defined( $_->init_arg ) } +$class->get_all_attributes + }; + + return +{ + map { +$_->init_arg => $_->get_value($instance) } + grep { $_->has_value($instance) } + grep { +defined( $_->init_arg ) } +$class->get_all_attributes + }; ---------- 'lp2' => <<'----------', @@ -635,6 +661,48 @@ my $test_var = #13........... }, + + 'git77.def' => { + source => "git77", + params => "def", + expect => <<'#14...........', + # These should format the same with -gal='Map Grep' + return +{ + Map { + $_->init_arg => $_->get_value($instance) + } Grep { $_->has_value($instance) } + Grep { + defined( $_->init_arg ) + } + $class->get_all_attributes + }; + + return +{ + map { $_->init_arg => $_->get_value($instance) } + grep { $_->has_value($instance) } + grep { defined( $_->init_arg ) } $class->get_all_attributes + }; +#14........... + }, + + 'git77.git77' => { + source => "git77", + params => "git77", + expect => <<'#15...........', + # These should format the same with -gal='Map Grep' + return +{ + Map { $_->init_arg => $_->get_value($instance) } + Grep { $_->has_value($instance) } + Grep { defined( $_->init_arg ) } $class->get_all_attributes + }; + + return +{ + map { $_->init_arg => $_->get_value($instance) } + grep { $_->has_value($instance) } + grep { defined( $_->init_arg ) } $class->get_all_attributes + }; +#15........... + }, }; my $ntests = 0 + keys %{$rtests};