From: Steve Hancock Date: Sun, 29 Jan 2023 23:57:46 +0000 (-0800) Subject: fix b1447; improve sub set_whitespace_flags X-Git-Tag: 20221112.05~3 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=b15df4dc31a62416df3509659cb52bf30ed328b0;p=perltidy.git fix b1447; improve sub set_whitespace_flags This should have been two commits. The first, fix b1447, is just 1 line and will influence almost no code. The second improves the efficiency of sub set_whitespace flags, mostly by processing comments faster. It also fixes a minor problem with marking a sub call for special formatting when a side comment appears between the sub name and opening paren (issue c182). --- diff --git a/dev-bin/run_convergence_tests.pl.data b/dev-bin/run_convergence_tests.pl.data index 3cebb220..bc9f7f35 100644 --- a/dev-bin/run_convergence_tests.pl.data +++ b/dev-bin/run_convergence_tests.pl.data @@ -11338,6 +11338,27 @@ $last = after ( --maximum-line-length=20 --opening-hash-brace-right +==> b1447.in <== + ok(defined($seqio= + $gb->get_Stream_by_batch([qw(J00522 AF303112 + 2981014)]))); + + ok(defined($seqio= + $gb->get_Stream_by_batch( + [qw(J00522 AF303112 + 2981014)]))); + +==> b1447.par <== +# note that notrim-qw converts the quote type from 'q' to 'Q' +--noadd-whitespace +--delete-old-whitespace +--extended-line-up-parentheses +--stack-opening-square-bracket +--notrim-qw +--vertical-tightness-closing=1 +--vertical-tightness=2 +--weld-nested-containers + ==> b146.in <== # State 1 diff --git a/dev-bin/run_convergence_tests.pl.expect b/dev-bin/run_convergence_tests.pl.expect index f1a4dbf3..289ca7d2 100644 --- a/dev-bin/run_convergence_tests.pl.expect +++ b/dev-bin/run_convergence_tests.pl.expect @@ -7694,6 +7694,17 @@ $last = after ( die "Unrecognized $type number: $num\n"; +==> b1447 <== + ok(defined($seqio= + $gb->get_Stream_by_batch([qw(J00522 AF303112 + 2981014)] ) + )); + + ok(defined($seqio= + $gb->get_Stream_by_batch([qw(J00522 AF303112 + 2981014)] ) + )); + ==> b146 <== # State 1 diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index 5dcc1ef4..d3b54033 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -2845,9 +2845,6 @@ sub set_whitespace_flags { my $j_tight_closing_paren = -1; my $rLL = $self->[_rLL_]; my $jmax = @{$rLL} - 1; - my $token = SPACE; - my $type = 'b'; - my $last_token = EMPTY_STRING; %opening_container_inside_ws = (); %closing_container_inside_ws = (); @@ -2865,41 +2862,34 @@ sub set_whitespace_flags { my %is_for_foreach = ( 'for' => 1, 'foreach' => 1 ); - my $rtokh; - my $rtokh_last = $rLL->[0]; - my $rtokh_last_last = $rtokh_last; - - my $last_type = EMPTY_STRING; + my $last_token = SPACE; + my $last_type = 'b'; - $rtokh = [ @{ $rLL->[0] } ]; + my $rtokh_last = [ @{ $rLL->[0] } ]; + $rtokh_last->[_TOKEN_] = $last_token; + $rtokh_last->[_TYPE_] = $last_type; + $rtokh_last->[_TYPE_SEQUENCE_] = EMPTY_STRING; + $rtokh_last->[_LINE_INDEX_] = 0; - $rtokh->[_TOKEN_] = $token; - $rtokh->[_TYPE_] = $type; - $rtokh->[_TYPE_SEQUENCE_] = EMPTY_STRING; - $rtokh->[_LINE_INDEX_] = 0; + my $rtokh_last_last = $rtokh_last; my ( $ws_1, $ws_2, $ws_3, $ws_4 ); # main loop over all tokens to define the whitespace flags my $last_type_is_opening; - foreach my $j ( 0 .. $jmax ) { + my ( $token, $type ); + my $j = -1; + foreach my $rtokh ( @{$rLL} ) { - if ( $rLL->[$j]->[_TYPE_] eq 'b' ) { + $j++; + + $type = $rtokh->[_TYPE_]; + if ( $type eq 'b' ) { $rwhitespace_flags->[$j] = WS_OPTIONAL; next; } - $last_token = $token; - $last_type = $type; - - if ( $type ne '#' ) { - $rtokh_last_last = $rtokh_last; - $rtokh_last = $rtokh; - } - - $rtokh = $rLL->[$j]; $token = $rtokh->[_TOKEN_]; - $type = $rtokh->[_TYPE_]; my $ws; @@ -3045,6 +3035,20 @@ sub set_whitespace_flags { } } + # handle a comment + elsif ( $type eq '#' ) { + + # newline before block comment ($j==0), and + # space before side comment ($j>0), so .. + $ws = WS_YES; + + #--------------------------------- + # Nothing more to do for a comment + #--------------------------------- + $rwhitespace_flags->[$j] = $ws; + next; + } + # retain any space between '-' and bare word elsif ( $type eq 'w' || $type eq 'C' ) { $ws = WS_OPTIONAL if $last_type eq '-'; @@ -3057,9 +3061,6 @@ sub set_whitespace_flags { $ws = WS_OPTIONAL if ( $last_type eq 'w' ); } - # always space before side comment - elsif ( $type eq '#' ) { $ws = WS_YES if $j > 0 } - # space_backslash_quote; RT #123774 <> # allow a space between a backslash and single or double quote # to avoid fooling html formatters @@ -3247,9 +3248,11 @@ sub set_whitespace_flags { # always preserve whatever space was used after a possible # filehandle (except _) or here doc operator if ( - $type ne '#' - && ( ( $last_type eq 'Z' && $last_token ne '_' ) - || $last_type eq 'h' ) + ( + ( $last_type eq 'Z' && $last_token ne '_' ) + || $last_type eq 'h' + ) + && $type ne '#' # no longer required due to early exit for '#' above ) { $ws = WS_OPTIONAL; @@ -3317,11 +3320,17 @@ sub set_whitespace_flags { if ( !$ws && $rtokh->[_LINE_INDEX_] != $rtokh_last->[_LINE_INDEX_] ) { - $ws = 1; + $ws = WS_YES; } $rwhitespace_flags->[$j] = $ws; + # remember non-blank, non-comment tokens + $last_token = $token; + $last_type = $type; + $rtokh_last_last = $rtokh_last; + $rtokh_last = $rtokh; + next if ( !DEBUG_WHITE ); my $str = substr( $last_token, 0, 15 ); @@ -10484,11 +10493,13 @@ sub setup_new_weld_measurements { # - Convert from '$ok_to_weld' to '$new_weld_ok' to fix b1162. # - relaxed constraints for b1227 # - added skip if type is 'q' for b1349 and b1350 b1351 b1352 b1353 + # - added skip if type is 'Q' for b1447 if ( $starting_ci && $rOpts_line_up_parentheses && $rOpts_delete_old_whitespace && !$rOpts_add_whitespace && $rLL->[$Kinner_opening]->[_TYPE_] ne 'q' + && $rLL->[$Kinner_opening]->[_TYPE_] ne 'Q' && defined($Kprev) ) { my $type_first = $rLL->[$Kfirst]->[_TYPE_]; diff --git a/t/snippets/expect/space_paren.def b/t/snippets/expect/space_paren.def index a7083ffb..1a83a5d5 100644 --- a/t/snippets/expect/space_paren.def +++ b/t/snippets/expect/space_paren.def @@ -2,3 +2,5 @@ myfunc( $a, $b, $c ); # test -sfp push( @array, $val ); # test -skp and also -sak='push' split( /\|/, $txt ); # test -skp and also -sak='push' my ( $v1, $v2 ) = @_; # test -sak='push' +$c-> #sub set_whitespace_flags must look back past side comment + bind( $o, $n, [ \&$q, \%m ] ); diff --git a/t/snippets/expect/space_paren.space_paren1 b/t/snippets/expect/space_paren.space_paren1 index 371dcba4..a783d579 100644 --- a/t/snippets/expect/space_paren.space_paren1 +++ b/t/snippets/expect/space_paren.space_paren1 @@ -2,3 +2,5 @@ myfunc ( $a, $b, $c ); # test -sfp push ( @array, $val ); # test -skp and also -sak='push' split ( /\|/, $txt ); # test -skp and also -sak='push' my ( $v1, $v2 ) = @_; # test -sak='push' +$c-> #sub set_whitespace_flags must look back past side comment + bind ( $o, $n, [ \&$q, \%m ] ); diff --git a/t/snippets/expect/space_paren.space_paren2 b/t/snippets/expect/space_paren.space_paren2 index 052af7c4..13c60421 100644 --- a/t/snippets/expect/space_paren.space_paren2 +++ b/t/snippets/expect/space_paren.space_paren2 @@ -2,3 +2,5 @@ myfunc( $a, $b, $c ); # test -sfp push ( @array, $val ); # test -skp and also -sak='push' split( /\|/, $txt ); # test -skp and also -sak='push' my ( $v1, $v2 ) = @_; # test -sak='push' +$c-> #sub set_whitespace_flags must look back past side comment + bind( $o, $n, [ \&$q, \%m ] ); diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt index f170789b..a2203c37 100644 --- a/t/snippets/packing_list.txt +++ b/t/snippets/packing_list.txt @@ -382,6 +382,9 @@ ../snippets27.t cpb.cpb ../snippets27.t cpb.def ../snippets27.t rt145706.def +../snippets27.t olbxl.def +../snippets27.t olbxl.olbxl1 +../snippets28.t olbxl.olbxl2 ../snippets3.t ce_wn1.ce_wn ../snippets3.t ce_wn1.def ../snippets3.t colin.colin @@ -522,6 +525,3 @@ ../snippets9.t rt98902.def ../snippets9.t rt98902.rt98902 ../snippets9.t rt99961.def -../snippets27.t olbxl.def -../snippets27.t olbxl.olbxl1 -../snippets28.t olbxl.olbxl2 diff --git a/t/snippets/space_paren.in b/t/snippets/space_paren.in index c807602b..c6805294 100644 --- a/t/snippets/space_paren.in +++ b/t/snippets/space_paren.in @@ -2,3 +2,5 @@ myfunc ( $a, $b, $c ); # test -sfp push ( @array, $val ); # test -skp and also -sak='push' split( /\|/, $txt ); # test -skp and also -sak='push' my ( $v1, $v2 ) = @_; # test -sak='push' +$c-> #sub set_whitespace_flags must look back past side comment + bind( $o, $n, [ \&$q, \%m ] ); diff --git a/t/snippets19.t b/t/snippets19.t index 753c5521..d3ed46fb 100644 --- a/t/snippets19.t +++ b/t/snippets19.t @@ -180,6 +180,8 @@ myfunc ( $a, $b, $c ); # test -sfp push ( @array, $val ); # test -skp and also -sak='push' split( /\|/, $txt ); # test -skp and also -sak='push' my ( $v1, $v2 ) = @_; # test -sak='push' +$c-> #sub set_whitespace_flags must look back past side comment + bind( $o, $n, [ \&$q, \%m ] ); ---------- 'tightness' => <<'----------', @@ -406,6 +408,8 @@ myfunc( $a, $b, $c ); # test -sfp push( @array, $val ); # test -skp and also -sak='push' split( /\|/, $txt ); # test -skp and also -sak='push' my ( $v1, $v2 ) = @_; # test -sak='push' +$c-> #sub set_whitespace_flags must look back past side comment + bind( $o, $n, [ \&$q, \%m ] ); #14........... }, @@ -417,6 +421,8 @@ myfunc ( $a, $b, $c ); # test -sfp push ( @array, $val ); # test -skp and also -sak='push' split ( /\|/, $txt ); # test -skp and also -sak='push' my ( $v1, $v2 ) = @_; # test -sak='push' +$c-> #sub set_whitespace_flags must look back past side comment + bind ( $o, $n, [ \&$q, \%m ] ); #15........... }, @@ -428,6 +434,8 @@ myfunc( $a, $b, $c ); # test -sfp push ( @array, $val ); # test -skp and also -sak='push' split( /\|/, $txt ); # test -skp and also -sak='push' my ( $v1, $v2 ) = @_; # test -sak='push' +$c-> #sub set_whitespace_flags must look back past side comment + bind( $o, $n, [ \&$q, \%m ] ); #16........... }, diff --git a/t/snippets28.t b/t/snippets28.t index 18bbaaf8..958a8b53 100644 --- a/t/snippets28.t +++ b/t/snippets28.t @@ -30,7 +30,7 @@ BEGIN { $rsources = { 'olbxl' => <<'----------', - eval { + eval { require Ace }; @list = map {