codetools: find references: find method overrides in other units

components/codetools/finddeclarationtool.pas

@@ -6762,7 +6762,8 @@ var
   CleanDeclCursorPos: integer;
   DeclarationTool: TFindDeclarationTool;
   DeclarationNode: TCodeTreeNode; // in DeclarationTool
-  AliasDeclarationNode: TCodeTreeNode; // if exists: always in front of DeclarationNode, and in DeclarationTool
+  AliasDeclarationNode: TCodeTreeNode; // if exists: for ProcHead this is the body,
+    // otherwise always in front of DeclarationNode, and in DeclarationTool
   Params: TFindDeclarationParams;
   PosTree: TAVLTree; // tree of PChar positions in Src
   ReferencePos: TCodeXYPosition;
@@ -6842,7 +6843,7 @@ var
     Node: TCodeTreeNode;
   begin
     Result:=false;
-    if ProcNode=AliasDeclarationNode.Parent then exit(true);
+    if ProcNode=DeclarationNode.Parent then exit(true);
     if not NodeIsMethodDecl(ProcNode) then
       exit;
     {$IFDEF VerboseFindRefMethodOverrides}
@@ -6867,14 +6868,14 @@ var
       CurProc:=CurProc.Tool.FindOverridenMethodDecl(CurProc.Node);
       if CurProc.Node=nil then begin
         {$IFDEF VerboseFindRefMethodOverrides}
-        debugln(['CheckMethodOverride Not an override']);
+        debugln(['CheckMethodOverride NOT an override']);
         {$ENDIF}
         break;
       end;
       {$IFDEF VerboseFindRefMethodOverrides}
-      debugln(['CheckMethodOverride found ancestor: ',CurProc.Tool.GetNodeNamePath(CurProc.Node,true,true)]);
+      debugln(['CheckMethodOverride FOUND ancestor: ',CurProc.Tool.GetNodeNamePath(CurProc.Node,true,true)]);
       {$ENDIF}
-      if CurProc.Node=AliasDeclarationNode.Parent then begin
+      if CurProc.Node=DeclarationNode.Parent then begin
         Result:=true;
         break;
       end;
@@ -6885,6 +6886,7 @@ var
       if Result then begin
         System.Insert(Node,OverrideProcNodes,length(OverrideProcNodes));
         if FoundProcs[i].Tool=Self then begin
+          AddNodeReference(Node); // rename decl of overridden proc
           Node:=FindCorrespondingProcNode(Node);
           if Node<>nil then begin
             System.Insert(Node,OverrideProcNodes,length(OverrideProcNodes));
@@ -7236,7 +7238,7 @@ var
 
     // find alias declaration node
     {$IFDEF VerboseFindReferences}
-    debugln('FindDeclarationNode DeclarationNode=',NodePathAsString(DeclarationNode),' at ',DeclarationTool.CleanPosToStr(DeclarationNode.StartPos));
+    debugln('FindDeclarationNode DeclarationNode=',DeclarationTool.GetNodeNamePath(DeclarationNode),'=',NodePathAsString(DeclarationNode),' at ',DeclarationTool.CleanPosToStr(DeclarationNode.StartPos));
     {$ENDIF}
     AliasDeclarationNode:=nil;
     case DeclarationNode.Desc of
@@ -7268,7 +7270,11 @@ var
         //debugln(['FindDeclarationNode adding alias node ...']);
         AddNodeReference(AliasDeclarationNode);
       end;
-      if AliasDeclarationNode.StartPos>DeclarationNode.StartPos then begin
+      if ((DeclarationNode.Desc=ctnProcedureHead)
+            and (AliasDeclarationNode.StartPos<DeclarationNode.StartPos))
+          or ((DeclarationNode.Desc<>ctnProcedureHead)
+            and (AliasDeclarationNode.StartPos>DeclarationNode.StartPos)) then
+      begin
         Node:=AliasDeclarationNode;
         AliasDeclarationNode:=DeclarationNode;
         DeclarationNode:=Node;
@@ -7285,8 +7291,8 @@ var
     {$ENDIF}
 
     if frfMethodOverrides in Flags then begin
-      if (AliasDeclarationNode=nil) or (AliasDeclarationNode.Desc<>ctnProcedureHead)
+      if (DeclarationNode.Desc<>ctnProcedureHead)
-          or (not NodeIsMethodDecl(AliasDeclarationNode.Parent)) then
+          or (not NodeIsMethodDecl(DeclarationNode.Parent)) then
         Exclude(Flags,frfMethodOverrides);
     end;
 
@@ -7329,7 +7335,7 @@ var
     end;
 
     StartNode:=DeclarationNode;
-    if (AliasDeclarationNode<>nil) then
+    if (AliasDeclarationNode<>nil) and (AliasDeclarationNode.StartPos<StartNode.StartPos) then
       StartNode:=AliasDeclarationNode;
     Node:=StartNode;
     while Node<>nil do begin
@@ -11914,7 +11920,7 @@ begin
 
   Identifier:=GetProcNameIdentifier(ProcNode);
   {$IFDEF VerboseFindRefMethodOverrides}
-  debugln(['TFindDeclarationTool.FindOverridenMethodDecl START ',GetNodeNamePath(ProcNode,true)]);
+  debugln(['TFindDeclarationTool.FindOverridenMethodDecl START ',GetNodeNamePath(ProcNode,true),' Identifier="',GetIdentifier(Identifier),'"']);
   {$ENDIF}
 
   Params:=TFindDeclarationParams.Create(Self,ClassNode);
@@ -11925,9 +11931,11 @@ begin
     while CurTool.FindAncestorOfClass(ClassNode,Params,true) do begin
       CurTool:=Params.NewCodeTool;
       ClassNode:=Params.NewNode;
+      //debugln(['  TFindDeclarationTool.FindOverridenMethodDecl Class=',CurTool.GetNodeNamePath(ClassNode)]);
 
       Node:=ClassNode.LastChild;
       while Node<>nil do begin
+        //debugln(['  TFindDeclarationTool.FindOverridenMethodDecl Node=',CurTool.GetNodeNamePath(Node),' ',Node.DescAsString]);
         if (Node.Desc in AllClassSections)
         and (Node.FirstChild<>nil) then begin
           Node:=Node.LastChild;
@@ -11941,7 +11949,8 @@ begin
           if CompareIdentifiers(CurIdentifier,Identifier)=0 then
             exit;
         end else if Node.Desc=ctnProcedure then begin
-          CurIdentifier:=GetProcNameIdentifier(Node);
+          CurIdentifier:=CurTool.GetProcNameIdentifier(Node);
+          //debugln(['  TFindDeclarationTool.FindOverridenMethodDecl PROC "',CurIdentifier,'"']);
           if CompareIdentifiers(CurIdentifier,Identifier)=0 then begin
             // found ancestor method with same name
             {$IFDEF VerboseFindRefMethodOverrides}

components/codetools/pascalreadertool.pas

@@ -1525,9 +1525,6 @@ end;
 
 function TPascalReaderTool.GetProcNameIdentifier(ProcNode: TCodeTreeNode): PChar;
 begin
-
-  // ToDo: ppu, dcu
-
   Result:=nil;
   if ProcNode=nil then exit;
   if ProcNode.Desc=ctnProcedure then begin
@@ -2348,6 +2345,7 @@ begin
   RestoreCurPos:=false;
   StartNode:=Node;
   Result:='';
+
   repeat
     s:='';
     case Node.Desc of
@@ -2372,7 +2370,9 @@ begin
     end;
     if s<>'' then begin
       if Result<>'' then
-        Result:='.'+Result;
+        Result:='.'+Result
+      else
+        Result:='['+StartNode.DescAsString+']';
       Result:=s+Result;
     end;
     Node:=Node.Parent;
@@ -2843,10 +2843,11 @@ begin
     else if UpAtomIs('DESTRUCTOR') then
       Result := mgClassDestructor
     else if UpAtomIs('OPERATOR') then
-      Result := mgClassOperator;
+      Result := mgClassOperator
-  end else
+    else
-  if UpAtomIs('CONSTRUCTOR') then
+      Result:=mgMethod;
-    Result := mgConstructor
+  end else if UpAtomIs('CONSTRUCTOR') then
+    Result := mgConstructor;
 end;
 
 function TPascalReaderTool.PositionInSourceName(CleanPos: integer): boolean;

components/codetools/tests/testrefactoring.pas

@@ -42,10 +42,12 @@ type
     procedure TestRenameMethodArgUp;
     procedure TestRenameMethodInherited;
     procedure TestRenameMethodWithOverrides;
+    procedure TestRenameMethodWithOverridesOtherUnit;
+    procedure TestRenameClassMethodWithOverrides;
     procedure TestRenameNestedProgramProcDown;
     procedure TestRenameNestedProgramProcUp;
     procedure TestRenameNestedUnitProcDown;
-    procedure TestRenameTypeAmp;
+    procedure TestRenameTypeToAmp;
   end;
 
 implementation
@@ -93,7 +95,7 @@ begin
     Fail('CodeToolBoss.FindMainDeclaration failed '+dbgs(DeclarationCaretXY)+' File='+Code.Filename);
   end;
 
-  //debugln(['TCustomTestRefactoring.RenameReferences ',DeclX,' ',DeclY,' "',Code.GetLine(DeclY-1,false),'"']);
+  //debugln(['TCustomTestRefactoring.RenameReferences X=',DeclX,' Y=',DeclY,' "',DeclCode.GetLine(DeclY-1,false),'"']);
 
   DeclarationCaretXY:=Point(DeclX,DeclY);
 
@@ -116,6 +118,7 @@ begin
     Files.Clear;
     while Node<>nil do begin
       UGUnit:=TUGUnit(Node.Data);
+      //debugln(['TCustomTestRefactoring.RenameReferences ',UGUnit.Filename]);
       Files.Add(UGUnit.Filename);
       Node:=Node.Successor;
     end;
@@ -665,6 +668,7 @@ begin
   'begin',
   '  inherited Fly;',
   '  Fly;',
+  '  // Fly',
   'end;',
   '',
   'procedure TBird.Fly;',
@@ -699,6 +703,7 @@ begin
   'begin',
   '  inherited Run;',
   '  Run;',
+  '  // Run',
   'end;',
   '',
   'procedure TBird.Run;',
@@ -712,6 +717,220 @@ begin
   '']);
 end;
 
+procedure TTestRefactoring.TestRenameMethodWithOverridesOtherUnit;
+var
+  DeclUnit: TCodeBuffer;
+begin
+  DeclUnit:=nil;
+  try
+    DeclUnit:=CodeToolBoss.CreateFile('decl.pp');
+    DeclUnit.Source:='unit Decl;'+LineEnding
+      +'interface'+LineEnding
+      +'type'+LineEnding
+      +'  TAnimal = class'+LineEnding
+      +'    procedure Walk(a: word); virtual; abstract;'+LineEnding
+      +'  end;'+LineEnding
+      +'  TBird = class(TAnimal)'+LineEnding
+      +'    procedure Walk(b: longint); virtual; abstract;'+LineEnding
+      +'    procedure Walk(a: word); override;'+LineEnding
+      +'  end;'+LineEnding
+      +'implementation'+LineEnding
+      +'procedure TBird.Walk(a: word);'+LineEnding
+      +'begin end;'+LineEnding
+      +'end.';
+
+    StartUnit;
+    Add([
+    'uses Decl;',
+    'type',
+    '  TBear = class(TAnimal)',
+    '    procedure Charge;',
+    '  end;',
+    '  TEagle = class(TBird)',
+    '    procedure Walk(c: int64);',
+    '    procedure Walk(a: word); override;',
+    '  end;',
+    '  TBig = class(TEagle)',
+    '    procedure Walk(b: longint); override;',
+    '    procedure Walk(a: word); override;',
+    '  end;',
+    'implementation',
+    '',
+    'procedure TBear.Charge;',
+    'var aWord: word;',
+    'begin',
+    '  Walk{#Rename}(aWord);',
+    'end;',
+    '',
+    'procedure TEagle.Walk(c: int64);',
+    'begin',
+    '  Walk(c);',
+    '  Walk(word(c));',
+    'end;',
+    '',
+    'procedure TEagle.Walk(a: word);',
+    'begin',
+    '  Walk(c);',
+    '  Walk(word(c));',
+    'end;',
+    '',
+    'procedure TBig.Walk(b: longint);',
+    'begin',
+    '  Walk(b);',
+    '  Walk(word(b));',
+    'end;',
+    '',
+    'procedure TBig.Walk(a: word);',
+    'begin',
+    '  Walk(a);',
+    '  Walk(longint(a));',
+    'end;',
+    '',
+    'end.',
+    '']);
+    RenameReferences('Run',[frfMethodOverrides]);
+    CheckDiff(Code,[
+    'unit test1;',
+    '',
+    '{$mode objfpc}{$H+}',
+    '',
+    'interface',
+    '',
+    'uses Decl;',
+    'type',
+    '  TBear = class(TAnimal)',
+    '    procedure Charge;',
+    '  end;',
+    '  TEagle = class(TBird)',
+    '    procedure Walk(c: int64);',
+    '    procedure Run(a: word); override;',
+    '  end;',
+    '  TBig = class(TEagle)',
+    '    procedure Walk(b: longint); override;',
+    '    procedure Run(a: word); override;',
+    '  end;',
+    'implementation',
+    '',
+    'procedure TBear.Charge;',
+    'var aWord: word;',
+    'begin',
+    '  Run{#Rename}(aWord);',
+    'end;',
+    '',
+    'procedure TEagle.Walk(c: int64);',
+    'begin',
+    '  Walk(c);',
+    '  Run(word(c));',
+    'end;',
+    '',
+    'procedure TEagle.Run(a: word);',
+    'begin',
+    '  Walk(c);',
+    '  Run(word(c));',
+    'end;',
+    '',
+    'procedure TBig.Walk(b: longint);',
+    'begin',
+    '  Walk(b);',
+    '  Run(word(b));',
+    'end;',
+    '',
+    'procedure TBig.Run(a: word);',
+    'begin',
+    '  Run(a);',
+    '  Walk(longint(a));',
+    'end;',
+    '',
+    'end.',
+    '']);
+  finally
+    if DeclUnit<>nil then
+      DeclUnit.IsDeleted:=true;
+  end;
+end;
+
+procedure TTestRefactoring.TestRenameClassMethodWithOverrides;
+begin
+  StartProgram;
+  Add([
+  'type',
+  '  TOuter = class',
+  '  public type',
+  '    TAnimal = class',
+  '      class procedure Fly{#Rename}; virtual;',
+  '    end;',
+  '    TBird = class(TAnimal)',
+  '      class procedure Eat;',
+  '      class procedure Fly; override;',
+  '    end;',
+  '  end;',
+  '',
+  'class procedure TOuter.TAnimal.Fly;',
+  'begin',
+  'end;',
+  '',
+  'class procedure TOuter.TBird.Eat;',
+  'begin',
+  '  TOuter.TAnimal.Fly;',
+  '  TOuter.TBird.Fly;',
+  '  Test1.TOuter.TAnimal.Fly;',
+  '  Test1.TOuter.TBird.Fly;',
+  '  // TOuter.TAnimal.Fly',
+  '  // TOuter.TBird.Fly',
+  '  // Test1.TOuter.TAnimal.Fly;',
+  '  // Test1.TOuter.TBird.Fly;',
+  'end;',
+  '',
+  'class procedure TOuter.TBird.Fly;',
+  'begin',
+  'end;',
+  '',
+  'begin',
+  'end.',
+  '']);
+  RenameReferences('Run',[frfMethodOverrides]);
+  CheckDiff(Code,[
+  'program test1;',
+  '',
+  '{$mode objfpc}{$H+}',
+  '',
+  'type',
+  '  TOuter = class',
+  '  public type',
+  '    TAnimal = class',
+  '      class procedure Run{#Rename}; virtual;',
+  '    end;',
+  '    TBird = class(TAnimal)',
+  '      class procedure Eat;',
+  '      class procedure Run; override;',
+  '    end;',
+  '  end;',
+  '',
+  'class procedure TOuter.TAnimal.Run;',
+  'begin',
+  'end;',
+  '',
+  'class procedure TOuter.TBird.Eat;',
+  'begin',
+  '  TOuter.TAnimal.Run;',
+  '  TOuter.TBird.Run;',
+  '  Test1.TOuter.TAnimal.Run;',
+  '  Test1.TOuter.TBird.Run;',
+  '  // TOuter.TAnimal.Run',
+  '  // TOuter.TBird.Run',
+  '  // Test1.TOuter.TAnimal.Run;',
+  '  // Test1.TOuter.TBird.Run;',
+  'end;',
+  '',
+  'class procedure TOuter.TBird.Run;',
+  'begin',
+  'end;',
+  '',
+  'begin',
+  'end.',
+  '']);
+end;
+
 procedure TTestRefactoring.TestRenameNestedProgramProcDown;
 begin
   StartProgram;
@@ -918,7 +1137,7 @@ begin
   '']);
 end;
 
-procedure TTestRefactoring.TestRenameTypeAmp;
+procedure TTestRefactoring.TestRenameTypeToAmp;
 begin
   StartUnit;
   Add([