update --dump-block-summary to mark nested loops
authorSteve Hancock <perltidy@users.sourceforge.net>
Wed, 14 Dec 2022 04:39:05 +0000 (20:39 -0800)
committerSteve Hancock <perltidy@users.sourceforge.net>
Wed, 14 Dec 2022 04:39:05 +0000 (20:39 -0800)
Nested loops are marked in the output with a +, and they can
be selected with a postfix + on the loop type.

bin/perltidy
lib/Perl/Tidy/Formatter.pm

index 4ab4eb4d8b3446d52775e7534bd1092fc2e0efcd..71ef6c33da1767dcff14c0285aaefe15bf844e01 100755 (executable)
@@ -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<package> 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<n> 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<type> 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<package> 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<n> 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<s> 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<sub if elsif else for foreach ..>) or
 the word immediately before the opening brace.  The type B<sub> selects both
 named subs and anonymous subs.  The special type B<asub> selects just anonymous
-subs, and the special type B<closure> selects nameless blocks.  Finally, the
-type B<*> selects all types except closures.   For example:
+subs, and the special type B<closure> 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<sub for foreach while>:
 
     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<sub> 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<package> statements are also always included.
 
 =item B<Working with MakeMaker, AutoLoader and SelfLoader>
 
index 2f8a9265157d223113636d77f0184ac738e1a99d..2e4abaed33101c86a2d8d5d0dfcfb9e9f2e4156e 100644 (file)
@@ -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' )
     {