codetools: find references: find method overrides in other units

2025-04-07 08:58:23 +02:00 · 2025-01-29 16:08:00 +01:00 · 2025-01-29 16:08:00 +01:00 · 90ddf0774e
commit 90ddf0774e
parent 5979037e86
3 changed files with 252 additions and 23 deletions
--- a/components/codetools/finddeclarationtool.pas
+++ b/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)
-          or (not NodeIsMethodDecl(AliasDeclarationNode.Parent)) then
+      if (DeclarationNode.Desc<>ctnProcedureHead)
+          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}
--- a/components/codetools/pascalreadertool.pas
+++ b/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;
-  end else
-  if UpAtomIs('CONSTRUCTOR') then
-    Result := mgConstructor
+      Result := mgClassOperator
+    else
+      Result:=mgMethod;
+  end else if UpAtomIs('CONSTRUCTOR') then
+    Result := mgConstructor;
 end;

 function TPascalReaderTool.PositionInSourceName(CleanPos: integer): boolean;
--- a/components/codetools/tests/testrefactoring.pas
+++ b/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([