From: Steve Hancock Date: Sat, 10 Jun 2023 02:55:08 +0000 (-0700) Subject: add parameters -xbt, -xbtl; see issue git #121 X-Git-Tag: 20230309.03~1 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=7c4aed499c856c2c00635bf1d37c583a2590dd02;p=perltidy.git add parameters -xbt, -xbtl; see issue git #121 --- diff --git a/CHANGES.md b/CHANGES.md index 42c536c9..a6034161 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,11 @@ ## 2023 03 09.02 + - Issue git #121. Added parameters -xbt, or --extended-block-tightness, + and -xbtl=s, or --extended-block-tightness-list=s, to allow + certain small code blocks to have internal spacing controlled by + -bbt=n instead of -bt=n. The man pages have details. + - Issue git #118. A warning will be issued if a duplicate format-skipping starting marker is seen within a format-skipping section. The same applies to duplicate code-skipping starting markers within code-skipping diff --git a/bin/perltidy b/bin/perltidy index 6e52e855..e643b705 100755 --- a/bin/perltidy +++ b/bin/perltidy @@ -1239,6 +1239,56 @@ To simplify input in the case that all of the tightness flags have the same value , the parameter <-act=n> or B<--all-containers-tightness=n> is an abbreviation for the combination <-pt=n -sbt=n -bt=n -bbt=n>. +=item B<-xbt>, B<--extended-block-tightness> + +Curly braces which are considered by perltidy to contain code blocks for +formatting purposes exclude some of the code blocks used by Perl mainly for +isolating terms. These include curly braces following a keyword where an +indirect object might occur, or curly braces following a type symbol. For +example + + print {*STDERR} $message; + return @{$self}; + +Since perltidy does not format these small containers as code blocks, by +default the spacing within for these braces follows the flag +B<--brace-tightness=n>. + +But they can be made to instead follow the spacing defined by the +B<--block-brace-tightness=n> flag by seting +B<--extended-block-tightness>. + +Note that if the two flags B<-bbt=n> and B<-bt=n> have the same value +B then there would be no reason to set this flag. + +=item B<-xbtl=s>, B<--extended-block-tightness-list=s> + +The small blocks to which the parameter B<-xbt> applies consist of those curly braces preceded by the keywords + + print printf sort exec system say + +and special symbols + + $ @ % & * $# + +To restrict B<-xbt> to apply to just the above keywords use + + -xbtl=k + +and to restrict it to apply to just the above special type symbols use + + -xbtl=t + +To restrict it to certain specific keywords or type symbols, enter them in the +parameter B. For example, the following restricts it apply to just the +keywords B and B: + + -xbtl="print say" + +Note that this parameter merely changes the way that the parameter +B<--extended-block-tightness> works. It has no effect unless +B<--extended-block-tightness> is set. + =item B<-tso>, B<--tight-secret-operators> @@ -5555,19 +5605,19 @@ The following list shows all short parameter names which allow a prefix 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 + dtt dwic dwls dwrs dws eos f 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 viu vmll vsc w + wfc wn x xbt xci xlp xs Equivalently, the prefix 'no' or 'no-' on the corresponding long names may be used. diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index aac92705..375eae54 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -3237,6 +3237,8 @@ sub generate_options { $add_option->( 'valign-exclusion-list', 'vxl', '=s' ); $add_option->( 'valign-inclusion-list', 'vil', '=s' ); $add_option->( 'valign-if-unless', 'viu', '!' ); + $add_option->( 'extended-block-tightness', 'xbt', '!' ); + $add_option->( 'extended-block-tightness-list', 'xbtl', '=s' ); ######################################## $category = 4; # Comment controls diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index 57967cb3..9d813ad4 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -235,6 +235,7 @@ my ( $rOpts_valign_side_comments, $rOpts_valign_if_unless, $rOpts_whitespace_cycle, + $rOpts_extended_block_tightness, $rOpts_extended_line_up_parentheses, # Static hashes @@ -315,6 +316,9 @@ my ( # INITIALIZER: sub initialize_space_after_keyword %space_after_keyword, + # INITIALIZER: sub initialize_extended_block_tightness_list + %extended_block_tightness_list, + # INITIALIZED BY initialize_global_option_vars %opening_vertical_tightness, %closing_vertical_tightness, @@ -1561,6 +1565,8 @@ EOM initialize_space_after_keyword(); + initialize_extended_block_tightness_list(); + initialize_token_break_preferences(); #-------------------------------------------------------------- @@ -2151,6 +2157,68 @@ sub initialize_space_after_keyword { return; } ## end sub initialize_space_after_keyword +sub initialize_extended_block_tightness_list { + + # keywords taking indirect objects: + my @k_list = keys %is_indirect_object_taker; + + # type symbols which may precede an opening block brace + my @t_list = qw($ @ % & *); + push @t_list, '$#'; + + # Set the default to include all keywords ant types. + # We will build the selection in %hash + my %hash; + my @all = ( @k_list, @t_list ); + @hash{@all} = (1) x scalar(@all); + + # This can be overridden with -xbtl="..." + my $long_name = 'extended-block-tightness-list'; + if ( $rOpts->{$long_name} ) { + my @words = split_words( $rOpts->{$long_name} ); + my @unknown; + + # Turn everything off + @hash{@all} = (0) x scalar(@all); + + # Then turn on selections + foreach my $word (@words) { + + # 'print' etc turns on a specific word or symbol + if ( defined( $hash{$word} ) ) { $hash{$word} = 1; } + + # 'k' turns on all keywords + elsif ( $word eq 'k' ) { + @hash{@k_list} = (1) x scalar(@k_list); + } + + # 't' turns on all symbols + elsif ( $word eq 't' ) { + @hash{@t_list} = (1) x scalar(@t_list); + } + + # 'kt' same as 'k' and 't' for convenience (same as default) + elsif ( $word eq 'kt' ) { + @hash{@all} = (1) x scalar(@all); + } + + # Anything else is an error + else { push @unknown, $word } + } + if (@unknown) { + my $num = @unknown; + local $LIST_SEPARATOR = SPACE; + Warn(<{'indent-only'}; $rOpts_keep_interior_semicolons = $rOpts->{'keep-interior-semicolons'}; $rOpts_line_up_parentheses = $rOpts->{'line-up-parentheses'}; + $rOpts_extended_block_tightness = $rOpts->{'extended-block-tightness'}; $rOpts_extended_line_up_parentheses = $rOpts->{'extended-line-up-parentheses'}; $rOpts_logical_padding = $rOpts->{'logical-padding'}; @@ -2896,6 +2965,9 @@ sub set_whitespace_flags { my $rtokh_last_last = $rtokh_last; + # This will identify braces to be treated as blocks for the -xbt flag + my %block_type_for_tightness; + my ( $ws_1, $ws_2, $ws_3, $ws_4 ); # main loop over all tokens to define the whitespace flags @@ -2929,7 +3001,8 @@ sub set_whitespace_flags { my $seqno = $rtokh->[_TYPE_SEQUENCE_]; my $block_type = $rblock_type_of_seqno->{$seqno}; my $last_seqno = $rtokh_last->[_TYPE_SEQUENCE_]; - my $last_block_type = $rblock_type_of_seqno->{$last_seqno}; + my $last_block_type = $rblock_type_of_seqno->{$last_seqno} + || $block_type_for_tightness{$last_seqno}; $j_tight_closing_paren = -1; @@ -2951,10 +3024,7 @@ sub set_whitespace_flags { # tightness = 2 means never pad inside with space my $tightness; - if ( $last_type eq '{' - && $last_token eq '{' - && $last_block_type ) - { + if ( $last_block_type && $last_token eq '{' ) { $tightness = $rOpts_block_brace_tightness; } else { $tightness = $tightness{$last_token} } @@ -3121,8 +3191,10 @@ sub set_whitespace_flags { if ( !defined($ws) ) { my $tightness; - my $block_type = $rblock_type_of_seqno->{$seqno}; - if ( $type eq '}' && $token eq '}' && $block_type ) { + my $block_type = $rblock_type_of_seqno->{$seqno} + || $block_type_for_tightness{$seqno}; + + if ( $block_type && $token eq '}' ) { $tightness = $rOpts_block_brace_tightness; } else { $tightness = $tightness{$token} } @@ -3266,6 +3338,19 @@ sub set_whitespace_flags { $ws = WS_NO; } } + + # The --extended-block-tightness option allows certain braces + # to be treated as blocks just for setting inner whitespace + if ( $rOpts_extended_block_tightness && $token eq '{' ) { + my $seqno = $rtokh->[_TYPE_SEQUENCE_]; + if ( !$rblock_type_of_seqno->{$seqno} + && $extended_block_tightness_list{$last_token} ) + { + + # Ok - make this brace a block type for tightness only + $block_type_for_tightness{$seqno} = $last_token; + } + } } ## end if ( $is_opening_type{$type} ) { # always preserve whatever space was used after a possible diff --git a/t/snippets/expect/xbt.def b/t/snippets/expect/xbt.def new file mode 100644 index 00000000..8175e26e --- /dev/null +++ b/t/snippets/expect/xbt.def @@ -0,0 +1,9 @@ +print {*STDERR} ${$data_sref}; +say {*STDERR} dump $c->{cookies}; +$rc = system {"lskdfj"} "lskdfj"; +test !eval { exec {'notaint'} $TAINT }, 'exec'; +delete ${"$ {dest}::"}{$name}; +my @matches = @{$nodes_ref} > 1 ? @{$nodes_ref}[ 1 .. $#{$nodes_ref} ] : (); +%{$self} = %{$project}; +*{$name} = $sub; +grep { defined &{ ${"${class}::"}{$_} } } &{"${class}::Clear"}(); diff --git a/t/snippets/expect/xbt.xbt1 b/t/snippets/expect/xbt.xbt1 new file mode 100644 index 00000000..1232e9f1 --- /dev/null +++ b/t/snippets/expect/xbt.xbt1 @@ -0,0 +1,10 @@ +print { *STDERR } ${ $data_sref }; +say { *STDERR } dump $c->{cookies}; +$rc = system { "lskdfj" } "lskdfj"; +test !eval { exec { 'notaint' } $TAINT }, 'exec'; +delete ${ "$ {dest}::" }{$name}; +my @matches = + @{ $nodes_ref } > 1 ? @{ $nodes_ref }[ 1 .. $#{ $nodes_ref } ] : (); +%{ $self } = %{ $project }; +*{ $name } = $sub; +grep { defined &{ ${ "${class}::" }{$_} } } &{ "${class}::Clear" }(); diff --git a/t/snippets/expect/xbt.xbt2 b/t/snippets/expect/xbt.xbt2 new file mode 100644 index 00000000..c2b711ea --- /dev/null +++ b/t/snippets/expect/xbt.xbt2 @@ -0,0 +1,9 @@ +print { *STDERR } ${$data_sref}; +say { *STDERR } dump $c->{cookies}; +$rc = system { "lskdfj" } "lskdfj"; +test !eval { exec { 'notaint' } $TAINT }, 'exec'; +delete ${"$ {dest}::"}{$name}; +my @matches = @{$nodes_ref} > 1 ? @{$nodes_ref}[ 1 .. $#{$nodes_ref} ] : (); +%{$self} = %{$project}; +*{$name} = $sub; +grep { defined &{ ${"${class}::"}{$_} } } &{"${class}::Clear"}(); diff --git a/t/snippets/expect/xbt.xbt3 b/t/snippets/expect/xbt.xbt3 new file mode 100644 index 00000000..a5b657e0 --- /dev/null +++ b/t/snippets/expect/xbt.xbt3 @@ -0,0 +1,9 @@ +print {*STDERR} ${$data_sref}; +say {*STDERR} dump $c->{cookies}; +$rc = system {"lskdfj"} "lskdfj"; +test !eval {exec {'notaint'} $TAINT}, 'exec'; +delete ${"$ {dest}::"}{$name}; +my @matches = @{$nodes_ref} > 1 ? @{$nodes_ref}[ 1 .. $#{$nodes_ref} ] : (); +%{$self} = %{$project}; +*{$name} = $sub; +grep {defined &{${"${class}::"}{$_}}} &{"${class}::Clear"}(); diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt index 221d442d..2b096e36 100644 --- a/t/snippets/packing_list.txt +++ b/t/snippets/packing_list.txt @@ -391,6 +391,10 @@ ../snippets28.t recombine8.def ../snippets28.t git116.def ../snippets28.t git116.git116 +../snippets28.t xbt.def +../snippets28.t xbt.xbt1 +../snippets28.t xbt.xbt2 +../snippets28.t xbt.xbt3 ../snippets3.t ce_wn1.ce_wn ../snippets3.t ce_wn1.def ../snippets3.t colin.colin diff --git a/t/snippets/xbt.in b/t/snippets/xbt.in new file mode 100644 index 00000000..1aa78d37 --- /dev/null +++ b/t/snippets/xbt.in @@ -0,0 +1,10 @@ +print {*STDERR} ${$data_sref}; +say {*STDERR} dump $c->{cookies}; +$rc = system {"lskdfj"} "lskdfj"; +test !eval { exec { 'notaint' } $TAINT }, 'exec'; +delete ${"$ {dest}::"}{$name}; +my @matches = @{$nodes_ref} > 1 ? @{$nodes_ref}[ 1 .. $#{$nodes_ref} ] : (); +%{$self} = %{$project}; +*{$name} = $sub; +grep { defined &{ ${ "${class}::" }{$_} } } +&{"${class}::Clear"}(); diff --git a/t/snippets/xbt1.par b/t/snippets/xbt1.par new file mode 100644 index 00000000..73611f1c --- /dev/null +++ b/t/snippets/xbt1.par @@ -0,0 +1 @@ +-xbt diff --git a/t/snippets/xbt2.par b/t/snippets/xbt2.par new file mode 100644 index 00000000..2a4dc0e3 --- /dev/null +++ b/t/snippets/xbt2.par @@ -0,0 +1 @@ +-xbt -xbtl=k diff --git a/t/snippets/xbt3.par b/t/snippets/xbt3.par new file mode 100644 index 00000000..fdcce469 --- /dev/null +++ b/t/snippets/xbt3.par @@ -0,0 +1 @@ +-xbt -bbt=2 -xbtl="print say t" diff --git a/t/snippets28.t b/t/snippets28.t index e0a3712d..f0c547bd 100644 --- a/t/snippets28.t +++ b/t/snippets28.t @@ -8,6 +8,10 @@ #5 recombine8.def #6 git116.def #7 git116.git116 +#8 xbt.def +#9 xbt.xbt1 +#10 xbt.xbt2 +#11 xbt.xbt3 # To locate test #13 you can search for its name or the string '#13' @@ -29,6 +33,11 @@ BEGIN { 'git116' => "-viu", 'olbxl2' => <<'----------', -olbxl='*' +---------- + 'xbt1' => "-xbt", + 'xbt2' => "-xbt -xbtl=k", + 'xbt3' => <<'----------', +-xbt -bbt=2 -xbtl="print say t" ---------- }; @@ -93,6 +102,19 @@ $rotate = Math::MatrixReal->new_from_string( "[ " . cos($theta) . " " . -sin($th 'recombine8' => <<'----------', # recombine uses normal forward mode $v_gb = -1*(eval($pmt_gb))*(-1+((((-1+(1/((eval($i_gb)/100)+1))** ((eval($n_gb)-1)))))/(eval($i_gb)/100))); +---------- + + 'xbt' => <<'----------', +print {*STDERR} ${$data_sref}; +say {*STDERR} dump $c->{cookies}; +$rc = system {"lskdfj"} "lskdfj"; +test !eval { exec { 'notaint' } $TAINT }, 'exec'; +delete ${"$ {dest}::"}{$name}; +my @matches = @{$nodes_ref} > 1 ? @{$nodes_ref}[ 1 .. $#{$nodes_ref} ] : (); +%{$self} = %{$project}; +*{$name} = $sub; +grep { defined &{ ${ "${class}::" }{$_} } } +&{"${class}::Clear"}(); ---------- }; @@ -215,6 +237,71 @@ print "RPM Output:\n" unless $Quiet; print join( "\n", @RPMOutput ) . "\n" unless $Quiet; #7........... }, + + 'xbt.def' => { + source => "xbt", + params => "def", + expect => <<'#8...........', +print {*STDERR} ${$data_sref}; +say {*STDERR} dump $c->{cookies}; +$rc = system {"lskdfj"} "lskdfj"; +test !eval { exec {'notaint'} $TAINT }, 'exec'; +delete ${"$ {dest}::"}{$name}; +my @matches = @{$nodes_ref} > 1 ? @{$nodes_ref}[ 1 .. $#{$nodes_ref} ] : (); +%{$self} = %{$project}; +*{$name} = $sub; +grep { defined &{ ${"${class}::"}{$_} } } &{"${class}::Clear"}(); +#8........... + }, + + 'xbt.xbt1' => { + source => "xbt", + params => "xbt1", + expect => <<'#9...........', +print { *STDERR } ${ $data_sref }; +say { *STDERR } dump $c->{cookies}; +$rc = system { "lskdfj" } "lskdfj"; +test !eval { exec { 'notaint' } $TAINT }, 'exec'; +delete ${ "$ {dest}::" }{$name}; +my @matches = + @{ $nodes_ref } > 1 ? @{ $nodes_ref }[ 1 .. $#{ $nodes_ref } ] : (); +%{ $self } = %{ $project }; +*{ $name } = $sub; +grep { defined &{ ${ "${class}::" }{$_} } } &{ "${class}::Clear" }(); +#9........... + }, + + 'xbt.xbt2' => { + source => "xbt", + params => "xbt2", + expect => <<'#10...........', +print { *STDERR } ${$data_sref}; +say { *STDERR } dump $c->{cookies}; +$rc = system { "lskdfj" } "lskdfj"; +test !eval { exec { 'notaint' } $TAINT }, 'exec'; +delete ${"$ {dest}::"}{$name}; +my @matches = @{$nodes_ref} > 1 ? @{$nodes_ref}[ 1 .. $#{$nodes_ref} ] : (); +%{$self} = %{$project}; +*{$name} = $sub; +grep { defined &{ ${"${class}::"}{$_} } } &{"${class}::Clear"}(); +#10........... + }, + + 'xbt.xbt3' => { + source => "xbt", + params => "xbt3", + expect => <<'#11...........', +print {*STDERR} ${$data_sref}; +say {*STDERR} dump $c->{cookies}; +$rc = system {"lskdfj"} "lskdfj"; +test !eval {exec {'notaint'} $TAINT}, 'exec'; +delete ${"$ {dest}::"}{$name}; +my @matches = @{$nodes_ref} > 1 ? @{$nodes_ref}[ 1 .. $#{$nodes_ref} ] : (); +%{$self} = %{$project}; +*{$name} = $sub; +grep {defined &{${"${class}::"}{$_}}} &{"${class}::Clear"}(); +#11........... + }, }; my $ntests = 0 + keys %{$rtests};