From 9d3347aabaf2c71dd43540ad6a7543df802fa684 Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Wed, 26 Jan 2022 19:23:55 -0800 Subject: [PATCH] added t/.gitattributes; trying to prevent auto cr/lf conversion --- .github/workflows/perltest.yml | 5 - bin/perltidy | 36 +++- lib/Perl/Tidy/Formatter.pm | 203 +++++++++++++++--- t/.gitattributes | 1 + ...sthrough.t.skip => testwide-passthrough.t} | 0 t/{testwide-tidy.t.skip => testwide-tidy.t} | 0 6 files changed, 204 insertions(+), 41 deletions(-) create mode 100644 t/.gitattributes rename t/{testwide-passthrough.t.skip => testwide-passthrough.t} (100%) rename t/{testwide-tidy.t.skip => testwide-tidy.t} (100%) diff --git a/.github/workflows/perltest.yml b/.github/workflows/perltest.yml index 2c67a88a..83bebeb1 100644 --- a/.github/workflows/perltest.yml +++ b/.github/workflows/perltest.yml @@ -50,11 +50,6 @@ jobs: # display the version of perl - just for possible manual verification - run: perl -V - # added to avoid problems with line ending conversions in git #83 update - - run: | - git config --global core.autocrlf false - git config --global core.eol lf - # Instal the dependencies declared by the module ... # There are no deps for perltidy, but this would be the command: # - run: cpanm --installdeps . diff --git a/bin/perltidy b/bin/perltidy index 6781835d..218e309e 100755 --- a/bin/perltidy +++ b/bin/perltidy @@ -3446,9 +3446,9 @@ To prevent this, and thereby always form longer lines, use B<-nboa>. =item B -Two command line parameters provide detailed control over whether -perltidy should keep an old line break before or after a specific -token type: +It is possible to override the choice of line breaks made by perltidy, and +force it to follow certain line breaks in the input stream, with these two +parameters: B<-kbb=s> or B<--keep-old-breakpoints-before=s>, and @@ -3486,6 +3486,36 @@ For example, given the script: ...; }; +For the container tokens '{', '[' and '(' and, their closing counterparts, use the token symbol. Thus, +the command to keep a break after all opening parens is: + + perltidy -kba='(' + +It is possible to be more specific in matching parentheses by preceding them +with a letter. The possible letters are 'k', 'K', 'f', 'F', 'w', and 'W', with +these meanings (these are the same as used in the +B<--weld-nested-exclusion-list> and B<--line-up-parentheses-exclusion-list> +parameters): + + 'k' matches if the previous nonblank token is a perl builtin keyword (such as 'if', 'while'), + 'K' matches if 'k' does not, meaning that the previous token is not a keyword. + 'f' matches if the previous token is a function other than a keyword. + 'F' matches if 'f' does not. + 'w' matches if either 'k' or 'f' match. + 'W' matches if 'w' does not. + +So for example the the following parameter will keep breaks after opening function call +parens: + + perltidy -kba='f(' + +B: To match all opening curly braces, and no other opening tokens, please +prefix the brace it with an asterisk, like this: '*{'. Otherwise a warning +message will occur. This is necessary to avoid problems while the input scheme +is being updated and generalized. A single bare curly brace previously matched +all container tokens, and tentatively still does. Likewise, to match all +closing curly braces, and no other closing tokens, use '*}'. + =item B<-iob>, B<--ignore-old-breakpoints> Use this flag to tell perltidy to ignore existing line breaks to the diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index 19392a31..f3a65c9f 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -1667,44 +1667,36 @@ EOM '?' => ':', ); - # note any requested old line breaks to keep - %keep_break_before_type = (); - %keep_break_after_type = (); - if ( !$rOpts->{'ignore-old-breakpoints'} ) { + if ( $rOpts->{'ignore-old-breakpoints'} ) { - # FIXME: could check for valid types here. - # Invalid types are harmless but probably not intended. - my @types; - @types = ( split_words( $rOpts->{'keep-old-breakpoints-before'} ) ); - @keep_break_before_type{@types} = (1) x scalar(@types); - @types = ( split_words( $rOpts->{'keep-old-breakpoints-after'} ) ); - @keep_break_after_type{@types} = (1) x scalar(@types); - } - else { + my @conflicts; if ( $rOpts->{'break-at-old-method-breakpoints'} ) { - Warn("Conflicting parameters: -iob and -bom; -bom will be ignored\n" - ); $rOpts->{'break-at-old-method-breakpoints'} = 0; + push @conflicts, '--break-at-old-method-breakpoints (-bom)'; } if ( $rOpts->{'break-at-old-comma-breakpoints'} ) { - Warn("Conflicting parameters: -iob and -boc; -boc will be ignored\n" - ); $rOpts->{'break-at-old-comma-breakpoints'} = 0; + push @conflicts, '--break-at-old-comma-breakpoints (-boc)'; } if ( $rOpts->{'break-at-old-semicolon-breakpoints'} ) { - Warn("Conflicting parameters: -iob and -bos; -bos will be ignored\n" - ); $rOpts->{'break-at-old-semicolon-breakpoints'} = 0; + push @conflicts, '--break-at-old-semicolon-breakpoints (-bos)'; } if ( $rOpts->{'keep-old-breakpoints-before'} ) { - Warn("Conflicting parameters: -iob and -kbb; -kbb will be ignored\n" - ); $rOpts->{'keep-old-breakpoints-before'} = ""; + push @conflicts, '--keep-old-breakpoints-before (-kbb)'; } if ( $rOpts->{'keep-old-breakpoints-after'} ) { - Warn("Conflicting parameters: -iob and -kba; -kba will be ignored\n" - ); $rOpts->{'keep-old-breakpoints-after'} = ""; + push @conflicts, '--keep-old-breakpoints-after (-kba)'; + } + + if (@conflicts) { + my $msg = join( "\n ", +" Conflict: These conflicts with --ignore-old-breakponts (-iob) will be turned off:", + @conflicts ) + . "\n"; + Warn($msg); } # Note: These additional parameters are made inactive by -iob. @@ -1716,6 +1708,14 @@ EOM $rOpts->{'break-at-old-attribute-breakpoints'} = 0; } + %keep_break_before_type = (); + initialize_keep_old_breakpoints( $rOpts->{'keep-old-breakpoints-before'}, + 'kbb', \%keep_break_before_type ); + + %keep_break_after_type = (); + initialize_keep_old_breakpoints( $rOpts->{'keep-old-breakpoints-after'}, + 'kba', \%keep_break_after_type ); + #------------------------------------------------------------ # Make global vars for frequently used options for efficiency #------------------------------------------------------------ @@ -2246,6 +2246,96 @@ EOM return; } +use constant DEBUG_KB => 0; + +sub initialize_keep_old_breakpoints { + my ( $str, $short_name, $rkeep_break_hash ) = @_; + return unless $str; + + my %flags = (); + my @list = split_words($str); + + # - pull out any any leading container letter code, like 'f( + map { s/^ ([\w\*]) ( [ [\{\(\[\}\)\] ] ) $/$2/x; $flags{$2} .= $1 if ($1) } + @list; + + @{$rkeep_break_hash}{@list} = (1) x scalar(@list); + + foreach my $key ( keys %flags ) { + my $flag = $flags{$key}; + + if ( length($flag) != 1 ) { + Warn(<{$key} = $flag; + } + + # Temporary patch and warning during changeover from using type to token for + # containers . This can be eliminated after one or two future releases. + if ( $rkeep_break_hash->{'{'} + && $rkeep_break_hash->{'{'} eq '1' + && !$rkeep_break_hash->{'('} + && !$rkeep_break_hash->{'['} ) + { + $rkeep_break_hash->{'('} = 1; + $rkeep_break_hash->{'['} = 1; + Warn(<{'}'} + && $rkeep_break_hash->{'}'} eq '1' + && !$rkeep_break_hash->{')'} + && !$rkeep_break_hash->{']'} ) + { + $rkeep_break_hash->{'('} = 1; + $rkeep_break_hash->{'['} = 1; + Warn(<[$KK]->[_TYPE_SEQUENCE_]; - my $type_first = $rLL->[$Kfirst]->[_TYPE_]; - if ( $keep_break_before_type{$type_first} ) { - $rbreak_before_Kfirst->{$Kfirst} = 1; + # non-container tokens use the type as the key + if ( !$seqno ) { + my $type = $rLL->[$KK]->[_TYPE_]; + if ( $rkeep_break_hash->{$type} ) { + $rbreak_hash->{$KK} = 1; + } } - my $type_last = $rLL->[$Klast]->[_TYPE_]; - if ( $keep_break_after_type{$type_last} ) { - $rbreak_after_Klast->{$Klast} = 1; + # container tokens use the token as the key + else { + my $token = $rLL->[$KK]->[_TOKEN_]; + my $flag = $rkeep_break_hash->{$token}; + if ($flag) { + + my $match = $flag eq '1' || $flag eq '*'; + + # check for special matching codes + if ( !$match ) { + if ( $token eq '(' || $token eq ')' ) { + $match = $self->match_paren_flag( $KK, $flag ); + } + elsif ( $token eq '{' || $token eq '}' ) { + + # codes for brace types could be expanded in the future + my $block_type = + $self->[_rblock_type_of_seqno_]->{$seqno}; + if ( $flag eq 'b' ) { $match = $block_type } + elsif ( $flag eq 'B' ) { $match = !$block_type } + else { + # unknown code - no match + } + } + } + $rbreak_hash->{$KK} = 1 if ($match); + } } + }; + + foreach my $item ( @{$rKrange_code_without_comments} ) { + my ( $Kfirst, $Klast ) = @{$item}; + $check_for_break->( + $Kfirst, \%keep_break_before_type, $rbreak_before_Kfirst + ); + $check_for_break->( + $Klast, \%keep_break_after_type, $rbreak_after_Klast + ); } return; } @@ -8204,15 +8332,24 @@ sub match_paren_flag { return 0 unless ( defined($flag) ); return 0 if $flag eq '0'; + return 1 if $flag eq '1'; return 1 if $flag eq '*'; return 0 unless ( defined($KK) ); my $rLL = $self->[_rLL_]; my $rtoken_vars = $rLL->[$KK]; + my $seqno = $rtoken_vars->[_TYPE_SEQUENCE_]; + return 0 unless ($seqno); + my $token = $rtoken_vars->[_TOKEN_]; + my $K_opening = $KK; + if ( !$is_opening_token{$token} ) { + $K_opening = $self->[_K_opening_container_]->{$seqno}; + } + return unless ( defined($K_opening) ); + my ( $is_f, $is_k, $is_w ); - my $Kp = $self->K_previous_nonblank($KK); + my $Kp = $self->K_previous_nonblank($K_opening); if ( defined($Kp) ) { - my $seqno = $rtoken_vars->[_TYPE_SEQUENCE_]; my $type_p = $rLL->[$Kp]->[_TYPE_]; # keyword? diff --git a/t/.gitattributes b/t/.gitattributes new file mode 100644 index 00000000..fa1385d9 --- /dev/null +++ b/t/.gitattributes @@ -0,0 +1 @@ +* -text diff --git a/t/testwide-passthrough.t.skip b/t/testwide-passthrough.t similarity index 100% rename from t/testwide-passthrough.t.skip rename to t/testwide-passthrough.t diff --git a/t/testwide-tidy.t.skip b/t/testwide-tidy.t similarity index 100% rename from t/testwide-tidy.t.skip rename to t/testwide-tidy.t -- 2.39.5