From: Steve Hancock <perltidy@users.sourceforge.net>
Date: Tue, 17 Oct 2023 00:41:43 +0000 (-0700)
Subject: fix arg counts for -dbs in some edge cases
X-Git-Tag: 20230912.04~1
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=145116d39518dd73b429f137a122298c25ec9c5c;p=perltidy.git

fix arg counts for -dbs in some edge cases
---

diff --git a/bin/perltidy b/bin/perltidy
index b8214f32..53ef0b9e 100755
--- a/bin/perltidy
+++ b/bin/perltidy
@@ -5410,12 +5410,18 @@ 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.
 
+For subroutines, the number of call arguments (args) is listed in parentheses
+in the C<type> column. For example, C<sub(9)> indicates a sub with 9 args.
+Subroutines whose arg count cannot easily be determined are indicated
+as C<sub(*)>.  The count does not include a leading variable named
+B<$self> or B<$class>.
+
 By default the table lists subroutines with more than 20 C<code_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 C<code_lines> to be included. The default is B<-n=20>.  Note that
-C<code_lines> is the number of lines excluding and comments, blanks and pod.
+C<code_lines> is the number of lines excluding comments, blanks and pod.
 
 B<--dump-block-types=s>, or B<-dbt=s>, where string B<s> is a list of block
 types to be included.  The type of a block is either the name of the perl
diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index 6f05d647..299686aa 100644
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -6734,6 +6734,7 @@ sub count_sub_args {
 
     # Count number of 'shift;' at the top level
     my $shift_count = 0;
+    my $saw_self;
 
     # Scan the container looking for args. Note that we need to include
     # the closing token to allow the signature search to finish correctly.
@@ -6799,12 +6800,15 @@ sub count_sub_args {
                 $shift_count++;
 
                 # Do not count leading '$self=shift' or '$class=shift'
-                if ( $shift_count == 1 ) {
-                    my $Km  = $K_nonblank[-2];
-                    my $K_m = @K_nonblank > 2 ? $K_nonblank[-2] : $K_opening;
+                #                        |   |   |
+                #   $K_nonblank[?] :    -3  -2  -1
+                if ( $shift_count == 1 && !$saw_self ) {
+                    my $Km  = $K_nonblank[-3];
+                    my $K_m = @K_nonblank > 3 ? $K_nonblank[-3] : $K_opening;
                     my $token_m = $rLL->[$K_m]->[_TOKEN_];
                     if ( $token_m eq '$self' || $token_m eq '$class' ) {
                         $shift_count--;
+                        $saw_self = 1;
                     }
                 }
             }
@@ -6830,12 +6834,30 @@ sub count_sub_args {
 
                 $arg_count_by_seqno{$seqno_current} = 0;
 
-                # subtract 1 if first token in list is '$self' or '$class'
-                my $K_p = $self->K_next_code($KK);
-                return '*' unless defined($K_p);
-                my $token_p = $rLL->[$K_p]->[_TOKEN_];
-                if ( $token_p eq '$self' || $token_p eq '$class' ) {
-                    $arg_count_by_seqno{$seqno_current} = -1;
+                # subtract 1 if first arg is (my|our) ? ($self|$class)
+                if ( !$shift_count && !$saw_self ) {
+                    my $K_p = $KK;
+                    for ( 1 .. 2 ) {
+                        $K_p = $self->K_next_code($K_p);
+                        return '*' unless defined($K_p);
+                        my $type_p  = $rLL->[$K_p]->[_TYPE_];
+                        my $token_p = $rLL->[$K_p]->[_TOKEN_];
+
+                        if (   $type_p eq 'k'
+                            && $token_p =~ /^(my|our|local)$/ )
+                        {
+                            next;
+                        }
+
+                        if (   $type_p eq 'i'
+                            && $token_p =~ /^\$(self|class)$/ )
+                        {
+                            $arg_count_by_seqno{$seqno_current} = -1;
+                            $saw_self = 1;
+                            last;
+                        }
+                        last;
+                    }
                 }
 
                 push @seqno_stack, $seqno_current;