fix arg counts for -dbs in some edge cases

diff --git a/bin/perltidy b/bin/perltidy
index b8214f322ffa62f46038dd107500e98d7b459a3b..53ef0b9ec26cf5fdf6ba90f2e2f11f177e9aec12 100755 (executable)
--- 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 6f05d6473dff2974d0e04346229fda8d6c4b70b1..299686aac8672750e9fc51ecef96dd2f539c98c8 100644 (file)
--- 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;