From: Steve Hancock <perltidy@users.sourceforge.net>
Date: Mon, 26 Aug 2024 21:46:05 +0000 (-0700)
Subject: fix minor issue with -wma
X-Git-Tag: 20240903~8
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=634fa6fd1c39a27b31abb53ba416e46a31e7f4cb;p=perltidy.git

fix minor issue with -wma
---

diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index ce79308e..e78f276d 100644
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -16319,6 +16319,7 @@ sub update_sub_call_paren_info {
         my $call_type = $is_ampersand_call ? '&' : EMPTY_STRING;
 
         my $caller_name = EMPTY_STRING;
+        my $class_name  = EMPTY_STRING;
         if ( $type_mm eq '->' ) {
             $call_type = '->';
             my $K_m   = $self->K_previous_code($Ko);
@@ -16330,6 +16331,15 @@ sub update_sub_call_paren_info {
                 if ( $type_mmm eq 'i' ) {
                     $caller_name = $token_mmm;
                 }
+                elsif ( $type_mmm eq 'w' ) {
+
+                    ##  A::B->do_something( $var1, $var2 );
+                    ##  wwww->iiiiiiiiiiii{ iiiii, iiiii };
+                    if ( index( $token_mmm, '::' ) >= 0 ) {
+                        $class_name = $token_mmm;
+                        $class_name =~ s/::$//;
+                    }
+                }
                 elsif ( $token_mmm eq ']' ) {
                     if ( $is_dollar_underscore_zero->($K_mmm) ) {
                         $caller_name = '$_[0]';
@@ -16349,6 +16359,11 @@ sub update_sub_call_paren_info {
             $package =~ s/\'/::/g;
             $package =~ s/::$//;
         }
+        else {
+            if ($class_name) {
+                $package = $class_name;
+            }
+        }
         if ( !$package ) { $package = 'main' }
 
         # count the args
@@ -16404,6 +16419,7 @@ sub update_sub_call_paren_info {
         $item->{line_number} = $line_number;
         $item->{call_type}   = $call_type;
         $item->{caller_name} = $caller_name;
+        $item->{class_name}  = $class_name;
     }
     return;
 } ## end sub update_sub_call_paren_info
@@ -16651,6 +16667,7 @@ sub cross_check_sub_calls {
         my $package          = $rcall_item->{package};
         my $name             = $rcall_item->{name};
         my $caller_name      = $rcall_item->{caller_name};
+        my $class_name       = $rcall_item->{class_name};
         my $key_receiver_sub = $package . '::' . $name;
         my $is_self_call;
 
@@ -16818,7 +16835,12 @@ sub cross_check_sub_calls {
               $rcall_item;
         }
         else {
-            $rcall_item->{is_external_call} = 1;
+
+            # mark calls made by unknown (non-self) objects, we can't track
+            # them, but we can track calls at the class level.
+            if ( !$class_name ) {
+                $rcall_item->{is_unknown_object_call} = 1;
+            }
         }
     }
 
@@ -16889,8 +16911,8 @@ sub cross_check_sub_calls {
 
         my $rcall_item = $rsub_call_paren_info_by_seqno->{$seqno};
 
-        # Skip external method calls
-        next if ( $rcall_item->{is_external_call} );
+        # Skip method calls by unknown objects
+        next if ( $rcall_item->{is_unknown_object_call} );
 
         my $arg_count           = $rcall_item->{arg_count};
         my $return_count_wanted = $rcall_item->{return_count_wanted};