From 1267a63e32a419a8d2aacbb2b5c3d418a5b4ab7b Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Tue, 13 Dec 2022 20:39:05 -0800 Subject: [PATCH] update --dump-block-summary to mark nested loops Nested loops are marked in the output with a +, and they can be selected with a postfix + on the loop type. --- bin/perltidy | 34 +++++++---- lib/Perl/Tidy/Formatter.pm | 115 +++++++++++++++++++++++-------------- 2 files changed, 95 insertions(+), 54 deletions(-) diff --git a/bin/perltidy b/bin/perltidy index 4ab4eb4d..71ef6c33 100755 --- a/bin/perltidy +++ b/bin/perltidy @@ -5017,14 +5017,16 @@ parameters: max_change - the change in depth to the most deeply nested code block block_count - the total number of code blocks nested in this block -These quantities can be useful for identifying complex code. Although the -table does not indicate which blocks are nested in other blocks, this can be -determined by computing and comparing the block ending line numbers. The table -also includes a line for each C statement in the file. By default -the table lists subroutines with more than 20 lines, but this can be changed -with the following two parameters: - -B<--dump-block-minimum-lines=n>, or B<-dbml=n>, where B is the minimum +These quantities can be useful for identifying complex code. For blocks which +are loops nested within loops, a postfix '+' to the C is added to +indicate possible code complexity. Although the table does not otherwise +indicate which blocks are nested in other blocks, this can be determined by +computing and comparing the block ending line numbers. The table also includes +a line for each C statement in the file. By default the table lists +subroutines with more than 20 lines, but this can be changed with the following +two parameters: + +B<--dump-block-minimum-lines=n>, or B<-dbl=n>, where B is the minimum number of lines to be included. The default is B<-n=20>. B<--dump-block-types=s>, or B<-dbt=s>, where string B is a list of block @@ -5032,12 +5034,22 @@ types to be included. The type of a block is either the name of the perl builtin keyword for that block (such as B) or the word immediately before the opening brace. The type B selects both named subs and anonymous subs. The special type B selects just anonymous -subs, and the special type B selects nameless blocks. Finally, the -type B<*> selects all types except closures. For example: +subs, and the special type B selects nameless blocks. The +type B<*> selects all types except closures. Block loops which are nested +in other loops can be selected by adding a B<+> after the block name. A single +token B<+> selects all nested block loops. Some examples: + +This selects block types C: perltidy -dbs -dbt='sub for foreach while' somefile.pl >blocks.csv -The default is B<-dbt='sub'>. +This selects blocks with two or more lines which are type C or which +are inner loops: + + perltidy -dbs -dbl=2 -dbt='sub +' somefile.pl >blocks.csv + +The default is B<-dbt='sub'>. In addition to the selected blocks, any +C statements are also always included. =item B diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index 2f8a9265..2e4abaed 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -5964,8 +5964,7 @@ sub find_level_info { # Find level ranges and total variations of all code blocks in this file. # Returns: - # ref to hash with seqno as key with this info: - # [ starting level, maximum level, total level variation] + # ref to hash with block info, with seqno as key (see below) my ($self) = @_; @@ -5988,19 +5987,33 @@ sub find_level_info { if ( $sseq > 0 ) { # STACK_LOOP: + my $item; foreach my $seq (@stack) { - my ( $starting_depth, $maximum_depth, $total_depth_gain ) = - @{ $level_info{$seq} }; - if ( $maximum_depth < $stack_depth ) { - $maximum_depth = $stack_depth; - } - $total_depth_gain++; - $level_info{$seq} = - [ $starting_depth, $maximum_depth, $total_depth_gain ]; + $item = $level_info{$seq}; + if ( $item->{maximum_depth} < $stack_depth ) { + $item->{maximum_depth} = $stack_depth; + } + $item->{block_count}++; } ## end STACK LOOP push @stack, $seq_next; - $level_info{$seq_next} = [ $stack_depth, $stack_depth, 1 ]; + my $block_type = $rblock_type_of_seqno->{$seq_next}; + + # If this block is a loop nested within a loop, then we + # will mark it as an 'inner_loop'. This is a useful + # complexity measure. + my $is_inner_loop = 0; + if ( $is_loop_type{$block_type} && defined($item) ) { + $is_inner_loop = $is_loop_type{ $item->{block_type} }; + } + + $level_info{$seq_next} = { + starting_depth => $stack_depth, + maximum_depth => $stack_depth, + block_count => 1, + block_type => $block_type, + is_inner_loop => $is_inner_loop, + }; } else { my $seq_test = pop @stack; @@ -6094,13 +6107,13 @@ sub find_packages { my $name = substr( $token, 8 ); push @package_list, { - line_start => $item->[_LINE_INDEX_] + 1, - line_count => 1, - name => $name, - type => 'package', - level => $item->[_LEVEL_], - max_change => 0, - total_change => 0, + line_start => $item->[_LINE_INDEX_] + 1, + line_count => 1, + name => $name, + type => 'package', + level => $item->[_LEVEL_], + max_change => 0, + block_count => 0, }; } } @@ -6180,6 +6193,19 @@ EOM next; } + my ( $max_change, $block_count, $inner_loop_plus ) = + ( 0, 0, EMPTY_STRING ); + my $item = $rlevel_info->{$seqno}; + if ( defined($item) ) { + my $starting_depth = $item->{starting_depth}; + my $maximum_depth = $item->{maximum_depth}; + $block_count = $item->{block_count}; + $max_change = $maximum_depth - $starting_depth + 1; + + # this is a '+' character if this block is an inner loops + $inner_loop_plus = $item->{is_inner_loop} ? '+' : EMPTY_STRING; + } + # Skip closures unless type 'closure' is explicitely requested if ( ( $block_type eq '}' || $block_type eq ';' ) && $dump_block_types{'closure'} ) @@ -6231,32 +6257,35 @@ EOM } } } + elsif ( + $is_loop_type{$block_type} + && ( $dump_all_types + || $dump_block_types{$block_type} + || $dump_block_types{ $block_type . $inner_loop_plus } + || $dump_block_types{$inner_loop_plus} ) + ) + { + $type = $block_type . $inner_loop_plus; + } elsif ( $dump_all_types || $dump_block_types{$block_type} ) { - $type = $block_type; if ( $is_loop_type{$block_type} ) { $name = $self->find_loop_label($seqno); } + $type = $block_type; } else { next; } - my ( $max_change, $total_change ) = ( 0, 0 ); - my $item = $rlevel_info->{$seqno}; - if ( defined($item) ) { - my ( $starting_depth, $maximum_depth, $tv ) = @{$item}; - $total_change = $tv; - $max_change = $maximum_depth - $starting_depth + 1; - } push @selected_blocks, { - line_start => $lx_open + 1, - line_count => $line_count, - name => $name, - type => $type, - level => $level, - max_change => $max_change, - total_change => $total_change, + line_start => $lx_open + 1, + line_count => $line_count, + name => $name, + type => $type, + level => $level, + max_change => $max_change, + block_count => $block_count, }; } ## END loop to get info for selected blocks return \@selected_blocks; @@ -6282,18 +6311,18 @@ sub dump_block_summary { # Merge and print to STDOUT my $routput_lines = []; foreach my $item ( @{$rselected_blocks}, @{$rpackage_list} ) { - my $line_start = $item->{line_start}; - my $line_count = $item->{line_count}; - my $type = $item->{type}; - my $name = $item->{name}; - my $level = $item->{level}; - my $max_change = $item->{max_change}; - my $total_change = $item->{total_change}; + my $line_start = $item->{line_start}; + my $line_count = $item->{line_count}; + my $type = $item->{type}; + my $name = $item->{name}; + my $level = $item->{level}; + my $max_change = $item->{max_change}; + my $block_count = $item->{block_count}; my $rline_vars = [ $input_stream_name, $line_start, $line_count, $type, $name, $level, - $max_change, $total_change + $max_change, $block_count ]; push @{$routput_lines}, $rline_vars; } @@ -6301,7 +6330,7 @@ sub dump_block_summary { my @merged_lines = sort { $a->[1] <=> $b->[1] } @{$routput_lines}; print STDOUT - "file,line,line_count,type,name,level,max_change,total_change\n"; + "file,line,line_count,type,name,level,max_change,block_count\n"; foreach my $rline_vars (@merged_lines) { my $line = join( ",", @{$rline_vars} ) . "\n"; @@ -8023,7 +8052,7 @@ sub store_space { # Store a blank space in the new array # - but never start the array with a space - # - and never store two consecutivespaces + # - and never store two consecutive spaces if ( @{$rLL_new} && $rLL_new->[-1]->[_TYPE_] ne 'b' ) { -- 2.39.5