codetools: find references: started find method overrides

components/codetools/codecompletiontool.pas

@@ -3690,7 +3690,7 @@ var
     if NeededType=ctnNone then exit;
     // add alias
     if NeededType<>Node.Desc then begin
-      DebugLn(['TCodeCompletionCodeTool.FindAliasDefinitions Wrong: ',Node.DescAsString,' ',ExtractNode(Node,[]),' ',Node.DescAsString,'<>',NodeDescToStr(NeededType)]);
+      DebugLn(['TCodeCompletionCodeTool.FindAliasDefinitions Wrong: ',Node.DescAsString,' ',ExtractNode(Node,[]),' ',Node.DescAsString,'<>',NodeDescriptionAsString(NeededType)]);
     end;
     if TreeOfCodeTreeNodeExt=nil then
       TreeOfCodeTreeNodeExt:=TAVLTree.Create(@CompareCodeTreeNodeExt);
@@ -3950,7 +3950,7 @@ begin
     ReferingType:=TCodeTreeNodeDesc(NodeExt.Flags);
     ReferingNode:=TCodeTreeNode(NodeExt.Data);
 
-    //DebugLn(['TCodeCompletionCodeTool.FixAliasDefinitions Old=',DefNode.DescAsString,' New=',NodeDescToStr(ReferingType)]);
+    //DebugLn(['TCodeCompletionCodeTool.FixAliasDefinitions Old=',DefNode.DescAsString,' New=',NodeDescriptionAsString(ReferingType)]);
 
     // check in front
     if ReferingType in [ctnTypeDefinition,ctnConstDefinition] then begin
@@ -5282,11 +5282,11 @@ function TCodeCompletionCodeTool.FixForwardDefinitions(
         end;
         InsertPos:=FindLineEndOrCodeAfterPosition(DestNode.StartPos);
         Indent:=Beauty.GetLineIndent(Src,DestNode.StartPos);
-        //DebugLn(['MoveNodes DestNode=',GetRedefinitionNodeText(DestNode),':',DestNode.DescAsString,' DestSection=',NodeDescToStr(DestSection)]);
+        //DebugLn(['MoveNodes DestNode=',GetRedefinitionNodeText(DestNode),':',DestNode.DescAsString,' DestSection=',NodeDescriptionAsString(DestSection)]);
       end;
       
       // start a new section if needed
-      //DebugLn(['MoveNodes LastInsertAtSamePos=',LastInsertAtSamePos,' NeedSection=',NodeDescToStr(NeedSection),' LastSection=',NodeDescToStr(LastSection),' DestSection=',NodeDescToStr(DestSection)]);
+      //DebugLn(['MoveNodes LastInsertAtSamePos=',LastInsertAtSamePos,' NeedSection=',NodeDescriptionAsString(NeedSection),' LastSection=',NodeDescriptionAsString(LastSection),' DestSection=',NodeDescriptionAsString(DestSection)]);
       if (LastInsertAtSamePos and (NeedSection<>LastSection))
       or ((not LastInsertAtSamePos) and (NeedSection<>DestSection)) then begin
         // start a new section
@@ -5332,7 +5332,7 @@ function TCodeCompletionCodeTool.FixForwardDefinitions(
       // restore destination section if needed
       if not NextInsertAtSamePos then begin
         // this was the last insertion at this destination
-        DebugLn(['MoveNodes this was the last insertion at this dest NeedSection=',NodeDescToStr(NeedSection),' DestSection=',NodeDescToStr(DestSection)]);
+        DebugLn(['MoveNodes this was the last insertion at this dest NeedSection=',NodeDescriptionAsString(NeedSection),' DestSection=',NodeDescriptionAsString(DestSection)]);
         if (DestNode.Desc in AllIdentifierDefinitions)
         and (NeedSection<>DestSection)
         and (DestSection in AllDefinitionSections) then begin

components/codetools/codetoolmanager.pas

@@ -559,8 +559,8 @@ type
     function FindReferences(IdentifierCode: TCodeBuffer;
           X, Y: integer; SearchInCode: TCodeBuffer; SkipComments: boolean;
           var ListOfPCodeXYPosition: TFPList;
-          var Cache: TFindIdentifierReferenceCache  // you must free Cache
+          var Cache: TFindIdentifierReferenceCache;  // you must free Cache
-          ): boolean;
+          const Flags: TFindRefsFlags = []): boolean;
     function FindUnitReferences(UnitCode, TargetCode: TCodeBuffer;
           SkipComments: boolean; var ListOfPCodeXYPosition: TFPList): boolean;
     function FindUsedUnitReferences(Code: TCodeBuffer; X, Y: integer;
@@ -569,7 +569,7 @@ type
     function FindReferencesInFiles(Files: TStringList;
           DeclarationCode: TCodeBuffer; const DeclarationCaretXY: TPoint;
           SearchInComments: boolean;
-          var TreeOfPCodeXYPosition: TAVLTree): boolean;
+          var TreeOfPCodeXYPosition: TAVLTree; const Flags: TFindRefsFlags = []): boolean;
     function RenameIdentifier(TreeOfPCodeXYPosition: TAVLTree;
           const OldIdentifier, NewIdentifier: string;
           DeclarationCode: TCodeBuffer; DeclarationCaretXY: PPoint): boolean;
@@ -2816,10 +2816,9 @@ begin
   end;
 end;
 
-function TCodeToolManager.FindReferences(IdentifierCode: TCodeBuffer; X,
+function TCodeToolManager.FindReferences(IdentifierCode: TCodeBuffer; X, Y: integer;
-  Y: integer; SearchInCode: TCodeBuffer; SkipComments: boolean;
+  SearchInCode: TCodeBuffer; SkipComments: boolean; var ListOfPCodeXYPosition: TFPList;
-  var ListOfPCodeXYPosition: TFPList; var Cache: TFindIdentifierReferenceCache
+  var Cache: TFindIdentifierReferenceCache; const Flags: TFindRefsFlags): boolean;
-  ): boolean;
 var
   CursorPos: TCodeXYPosition;
   NewTopLine: integer;
@@ -2911,7 +2910,7 @@ begin
   {$ENDIF}
   try
     Result:=FCurCodeTool.FindReferences(CursorPos,SkipComments,
-                                        ListOfPCodeXYPosition);
+                                        ListOfPCodeXYPosition,Flags);
   except
     on e: Exception do HandleException(e);
   end;
@@ -2969,9 +2968,9 @@ begin
   {$ENDIF}
 end;
 
-function TCodeToolManager.FindReferencesInFiles(Files: TStringList;
+function TCodeToolManager.FindReferencesInFiles(Files: TStringList; DeclarationCode: TCodeBuffer;
-  DeclarationCode: TCodeBuffer; const DeclarationCaretXY: TPoint;
+  const DeclarationCaretXY: TPoint; SearchInComments: boolean; var TreeOfPCodeXYPosition: TAVLTree;
-  SearchInComments: boolean; var TreeOfPCodeXYPosition: TAVLTree): boolean;
+  const Flags: TFindRefsFlags): boolean;
 var
   i, j: Integer;
   Code: TCodeBuffer;
@@ -3005,7 +3004,7 @@ begin
       FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
       if not FindReferences(
         DeclarationCode,DeclarationCaretXY.X,DeclarationCaretXY.Y,
-        Code, not SearchInComments, ListOfPCodeXYPosition, Cache) then
+        Code, not SearchInComments, ListOfPCodeXYPosition, Cache, Flags) then
       begin
         debugln('TCodeToolManager.FindReferencesInFiles unable to FindReferences in "',Code.Filename,'"');
         exit;

components/codetools/codetree.pas

@@ -53,6 +53,7 @@ uses
 type
   TCodeTreeNodeDesc = word;
   TCodeTreeNodeSubDesc = word;
+  TCodeTreeNodeDescArray = array of TCodeTreeNodeDesc;
 
 const
   // CodeTreeNodeDescriptors
@@ -320,6 +321,7 @@ type
     procedure ConsistencyCheck;
     procedure WriteDebugReport(const Prefix: string; WithChilds: boolean);
   end;
+  TCodeTreeNodeArray = array of TCodeTreeNode;
 
   { TCodeTree }
 

components/codetools/customcodetool.pas

@@ -337,8 +337,7 @@ type
 
     // debugging
     procedure Clear; virtual;
-    function NodeDescToStr(Desc: integer): string;
+    function NodeSubDescToStr(Desc: TCodeTreeNodeDesc; SubDesc: TCodeTreeNodeSubDesc): string;
-    function NodeSubDescToStr(Desc, SubDesc: integer): string;
     procedure ConsistencyCheck; virtual;
     procedure WriteDebugTreeReport;
     procedure CalcMemSize(Stats: TCTMemStats); virtual;
@@ -582,12 +581,8 @@ begin
   FRangeValidTill:=lsrNone;
 end;
 
-function TCustomCodeTool.NodeDescToStr(Desc: integer): string;
+function TCustomCodeTool.NodeSubDescToStr(Desc: TCodeTreeNodeDesc; SubDesc: TCodeTreeNodeSubDesc
-begin
+  ): string;
-  Result:=NodeDescriptionAsString(TCodeTreeNodeDesc(Desc));
-end;
-
-function TCustomCodeTool.NodeSubDescToStr(Desc, SubDesc: integer): string;
 begin
   if SubDesc<>0 then
     Result:=Format(ctsUnknownSubDescriptor,[IntToStr(SubDesc)])
@@ -2610,7 +2605,7 @@ procedure TCustomCodeTool.WriteDebugTreeReport;
     while RootNode<>nil do begin
       DbgOut(Indent);
       with RootNode do begin
-        DbgOut(NodeDescToStr(Desc)+'('+NodeSubDescToStr(Desc,SubDesc)+')  ');
+        DbgOut(NodeDescriptionAsString(Desc)+'('+NodeSubDescToStr(Desc,SubDesc)+')  ');
         DbgOut(' Start='+DbgS(StartPos),' ');
         WriteSrcSubString(StartPos,5);
         DbgOut(' End='+DbgS(EndPos)+' ');

components/codetools/finddeclarationtool.pas

@@ -68,6 +68,7 @@ interface
 { $DEFINE VerboseCPS}
 { $DEFINE VerboseFindDeclarationAndOverload}
 { $DEFINE VerboseFindFileAtCursor}
+{ $DEFINE VerboseFindRefMethodOverrides}
 
 {$IFDEF CTDEBUG}{$DEFINE DebugPrefix}{$ENDIF}
 {$IFDEF ShowTriedIdentifiers}{$DEFINE DebugPrefix}{$ENDIF}
@@ -219,6 +220,7 @@ type
     Tool: TFindDeclarationTool;
   end;
   PFindContext = ^TFindContext;
+  TFindContextArray = array of TFindContext;
   
 const
   CleanFindContext: TFindContext = (Node:nil; Tool:nil);
@@ -440,6 +442,8 @@ type
   //----------------------------------------------------------------------------
   // TTypeAliasOrderList is used for comparing type aliases in binary operators
 
+  { TTypeAliasItem }
+
   TTypeAliasItem = class
   public
     AliasName: string;
@@ -705,6 +709,12 @@ type
     foeEnumeratorCurrentExprType // expression type of 'enumerator Current'
     );
 
+  // flags for FindReferences
+  TFindRefsFlag = (
+    frfMethodOverrides // continue search on method overrides
+    );
+  TFindRefsFlags = set of TFindRefsFlag;
+
   TFindFileAtCursorFlag = (
     ffatNone,
     ffatUsedUnit,
@@ -727,7 +737,18 @@ type
 
   //----------------------------------------------------------------------------
 
-  TFindIdentifierInUsesSection_FindMissingFPCUnit = class;
+  TFindIdentifierInUsesSection_FindMissingFPCUnit = class
+  private
+    FUnitName: string;
+    FFound: Boolean;
+    FResults: TStringList;
+    procedure Iterate(const AFilename: string);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function Find(const AUnitName: string; const ADirectoryCache: TCTDirectoryCache): Boolean;
+    function IsInResults(const AUnitName: string): Boolean;
+  end;
 
   //----------------------------------------------------------------------------
 
@@ -1040,7 +1061,8 @@ type
     function FindExtendedExprOfHelper(HelperNode: TCodeTreeNode): TExpressionType;
 
     function FindReferences(const CursorPos: TCodeXYPosition;
-      SkipComments: boolean; out ListOfPCodeXYPosition: TFPList): boolean;
+      SkipComments: boolean; out ListOfPCodeXYPosition: TFPList;
+      Flags: TFindRefsFlags = []): boolean;
     function FindUnitReferences(UnitCode: TCodeBuffer;
       SkipComments: boolean; out ListOfPCodeXYPosition: TFPList): boolean; // searches unitname of UnitCode
     procedure FindUsedUnitReferences(const CursorPos: TCodeXYPosition;
@@ -1066,6 +1088,7 @@ type
     function FindNthParameterNode(Node: TCodeTreeNode;
                                   ParameterIndex: integer): TCodeTreeNode;
     function GetFirstParameterNode(Node: TCodeTreeNode): TCodeTreeNode;
+    function FindOverridenMethodDecl(ProcNode: TCodeTreeNode): TFindContext;
     function IsParamNodeListCompatibleToExprList(
       TargetExprParamList: TExprTypeList;
       FirstSourceParameterNode: TCodeTreeNode;
@@ -1115,19 +1138,6 @@ type
     property OnRescanFPCDirectoryCache: TNotifyEvent read FOnRescanFPCDirectoryCache write FOnRescanFPCDirectoryCache;
   end;
 
-  TFindIdentifierInUsesSection_FindMissingFPCUnit = class
-  private
-    FUnitName: string;
-    FFound: Boolean;
-    FResults: TStringList;
-    procedure Iterate(const AFilename: string);
-  public
-    constructor Create;
-    destructor Destroy; override;
-    function Find(const AUnitName: string; const ADirectoryCache: TCTDirectoryCache): Boolean;
-    function IsInResults(const AUnitName: string): Boolean;
-  end;
-
 function ExprTypeToString(const ExprType: TExpressionType): string;
 function CreateExpressionType(const Desc, SubDesc: TExpressionTypeDesc;
   const Context: TFindContext): TExpressionType;
@@ -6745,7 +6755,7 @@ end;
   at CursorPos.
 -------------------------------------------------------------------------------}
 function TFindDeclarationTool.FindReferences(const CursorPos: TCodeXYPosition;
-  SkipComments: boolean; out ListOfPCodeXYPosition: TFPList): boolean;
+  SkipComments: boolean; out ListOfPCodeXYPosition: TFPList; Flags: TFindRefsFlags): boolean;
 var
   DeclarationFound: boolean;
   Identifier: string;
@@ -6760,6 +6770,8 @@ var
   CursorNode: TCodeTreeNode;
   UnitStartFound, Found: Boolean;
   StartPos: integer; // keep this here, it is modified at several places
+  OverrideProcNodes: TCodeTreeNodeArray; // found override methods
+  NotOverrideProcNodes: TCodeTreeNodeArray; // found method with same name, but are not overrides
 
   procedure AddReference(ACleanPos: integer);
   var
@@ -6798,6 +6810,92 @@ var
     and (Node.FirstChild.Desc=ctnProcedureHead) then
       Node:=Node.FirstChild;
   end;
+
+  function ArrayHasNode(const Arr: TCodeTreeNodeArray; Node: TCodeTreeNode): boolean;
+  var
+    i: Integer;
+  begin
+    for i:=0 to length(Arr)-1 do
+      if Arr[i]=Node then exit(true);
+    Result:=false;
+  end;
+
+  function IsDeclarationNode(Node: TCodeTreeNode): boolean;
+  begin
+    UseProcHead(Node);
+    if (Node=DeclarationNode) or (Node=AliasDeclarationNode) then exit(true);
+
+    // check method overrides
+    if Node.Desc=ctnProcedureHead then begin
+      if ArrayHasNode(OverrideProcNodes,Node.Parent) then
+        exit(true);
+    end;
+
+    Result:=false;
+  end;
+
+  function CheckMethodOverride(ProcNode: TCodeTreeNode): boolean;
+  var
+    FoundProcs: TFindContextArray;
+    CurProc: TFindContext;
+    i: Integer;
+    Node: TCodeTreeNode;
+  begin
+    Result:=false;
+    if ProcNode=AliasDeclarationNode.Parent then exit(true);
+    if not NodeIsMethodDecl(ProcNode) then
+      exit;
+    {$IFDEF VerboseFindRefMethodOverrides}
+    debugln(['CheckMethodOverride found method: ',GetNodeNamePath(ProcNode,true,true)]);
+    {$ENDIF}
+    if not ProcNodeHasSpecifier(ProcNode,psOverride) then exit;
+
+    FoundProcs:=[];
+    CurProc:=CreateFindContext(Self,ProcNode);
+    repeat
+      if ArrayHasNode(OverrideProcNodes,CurProc.Node) then begin
+        Result:=true;
+        break;
+      end;
+      if ArrayHasNode(NotOverrideProcNodes,CurProc.Node) then
+        break;
+      System.Insert(CurProc,FoundProcs,length(FoundProcs));
+
+      {$IFDEF VerboseFindRefMethodOverrides}
+      debugln(['CheckMethodOverride searching ancestor of ',CurProc.Tool.GetNodeNamePath(CurProc.Node,true,true)]);
+      {$ENDIF}
+      CurProc:=CurProc.Tool.FindOverridenMethodDecl(CurProc.Node);
+      if CurProc.Node=nil then begin
+        {$IFDEF VerboseFindRefMethodOverrides}
+        debugln(['CheckMethodOverride Not an override']);
+        {$ENDIF}
+        break;
+      end;
+      {$IFDEF VerboseFindRefMethodOverrides}
+      debugln(['CheckMethodOverride found ancestor: ',CurProc.Tool.GetNodeNamePath(CurProc.Node,true,true)]);
+      {$ENDIF}
+      if CurProc.Node=AliasDeclarationNode.Parent then begin
+        Result:=true;
+        break;
+      end;
+    until false;
+
+    for i:=0 to length(FoundProcs)-1 do begin
+      Node:=FoundProcs[i].Node;
+      if Result then begin
+        System.Insert(Node,OverrideProcNodes,length(OverrideProcNodes));
+        if FoundProcs[i].Tool=Self then begin
+          Node:=FindCorrespondingProcNode(Node);
+          if Node<>nil then begin
+            System.Insert(Node,OverrideProcNodes,length(OverrideProcNodes));
+            AddNodeReference(Node); // rename body of overridden proc
+          end;
+        end;
+      end else begin
+        System.Insert(Node,NotOverrideProcNodes,length(NotOverrideProcNodes))
+      end;
+    end;
+  end;
   
   procedure ReadIdentifier(IsComment: boolean);
   var
@@ -6809,7 +6907,7 @@ var
     IdentStripped: string;
     aComment: string;
     UnitInFilename: ansistring;
-    Node: TCodeTreeNode;
+    Node, aClassNode, ProcNode: TCodeTreeNode;
     IsDotted: boolean;
     dLen: integer;
   begin
@@ -6863,14 +6961,20 @@ var
     begin
       AddReference(IdentStartPos);
     end else if (DeclarationTool=Self)
-    and ((IdentStartPos=CleanDeclCursorPos) or (CursorNode=AliasDeclarationNode))
+    and ((IdentStartPos=CleanDeclCursorPos) or IsDeclarationNode(CursorNode))
     then begin
       // declaration itself found
       //debugln(['ReadIdentifier declaration itself found, adding ...']);
       AddReference(IdentStartPos)
     end
-    else if CleanPosIsDeclarationIdentifier(IdentStartPos,CursorNode) then
+    else if CleanPosIsDeclarationIdentifier(IdentStartPos,CursorNode) then begin
       // this identifier is another declaration with the same name
+      if (frfMethodOverrides in Flags) and (CursorNode.Desc=ctnProcedureHead) then
+      begin
+        if CheckMethodOverride(CursorNode.Parent) then
+          AddReference(CursorNode.StartPos);
+      end;
+    end
     else begin
       // find declaration
       if Params=nil then
@@ -6905,55 +7009,60 @@ var
           raise;
       end;
 
+      if not Found then exit;
       //debugln(' Found=',dbgs(Found));
       Node:=Params.NewNode;
-      if Found and (Node<>nil) {and (Node.Parent<>nil)} then begin
+      if Node=nil then exit;
-        if (Node.Desc = ctnSrcName) then begin
+
-          //Node:=Node.Parent;
+      if (Node.Desc = ctnSrcName) then begin
-          MoveCursorToCleanPos(Node.StartPos);
+        MoveCursorToCleanPos(Node.StartPos);
-          AnUnitName:=ExtractIdentifierWithPoints(Node.StartPos,false);
+        AnUnitName:=ExtractIdentifierWithPoints(Node.StartPos,false);
-          {$IFDEF EnableFKnownIdentLength}
+        {$IFDEF EnableFKnownIdentLength}
-          if FKnownIdentLength>0 then
+        if FKnownIdentLength>0 then
-            delete(AnUnitName,FKnownIdentLength+1, length(AnUnitName));
+          delete(AnUnitName,FKnownIdentLength+1, length(AnUnitName));
-          {$ENDIF}
+        {$ENDIF}
-          //AnUnitName:=GetDottedIdentifier(@Src[Node.StartPos]); //program, library, package
+        //AnUnitName:=GetDottedIdentifier(@Src[Node.StartPos]); //program, library, package
-          NewCodeTool:=FindCodeToolForUsedUnit(AnUnitName, '',false);
+        NewCodeTool:=FindCodeToolForUsedUnit(AnUnitName, '',false);
-          if NewCodeTool=DeclarationTool then begin
+        if NewCodeTool=DeclarationTool then begin
-            AddReference(IdentStartPos);
+          AddReference(IdentStartPos);
-            exit;
+          exit;
-          end;
+        end;
-        end else
+      end else
-        if ( (Node.Desc=ctnUseUnit) or
+      if ( (Node.Desc=ctnUseUnit) or
-          ((DeclarationNode<>nil) and (Node.Parent<>nil) and (Node.Parent.Desc=ctnUseUnit)) )
+        ((DeclarationNode<>nil) and (Node.Parent<>nil) and (Node.Parent.Desc=ctnUseUnit)) )
-        and (Params.NewCodeTool=Self)
+      and (Params.NewCodeTool=Self)
+      then begin
+        // identifier is a unit reference
+        if (DeclarationNode.Desc=ctnSrcName)
+        or ((DeclarationNode.Parent<>nil) and (DeclarationNode.Parent.Desc=ctnSrcName))
         then begin
-          // identifier is a unit reference
+          // searching a unit reference -> check if it is the same
-          if (DeclarationNode.Desc=ctnSrcName)
+          MoveCursorToNodeStart(Node);
-          or ((DeclarationNode.Parent<>nil) and (DeclarationNode.Parent.Desc=ctnSrcName))
+          if ReadNextUsedUnit(UnitNamePos,UnitInFilePos) then begin
-          then begin
+            // cursor is on an used unit -> try to locate it
-            // searching a unit reference -> check if it is the same
+            MoveCursorToCleanPos(UnitNamePos.StartPos);
-            MoveCursorToNodeStart(Node);
+            ReadNextAtom;
-            if ReadNextUsedUnit(UnitNamePos,UnitInFilePos) then begin
+            AnUnitName:=ExtractUsedUnitNameAtCursor(@UnitInFilename);
-              // cursor is on an used unit -> try to locate it
+            NewCodeTool:=FindCodeToolForUsedUnit(AnUnitName,UnitInFilename,false);
-              MoveCursorToCleanPos(UnitNamePos.StartPos);
+            if NewCodeTool=DeclarationTool then begin
-              ReadNextAtom;
+              AddReference(IdentStartPos);
-              AnUnitName:=ExtractUsedUnitNameAtCursor(@UnitInFilename);
+              exit;
-              NewCodeTool:=FindCodeToolForUsedUnit(AnUnitName,UnitInFilename,false);
-              if NewCodeTool=DeclarationTool then begin
-                AddReference(IdentStartPos);
-                exit;
-              end;
             end;
           end;
         end;
+      end;
 
-        UseProcHead(Node);
+      //debugln('Found=',Params.NewCodeTool.GetNodeNamePath(Node,true,true),' Searched=',DeclarationTool.GetNodeNamePath(DeclarationNode,true,true));
-        //debugln('Context=',NodePathAsString(Params.NewNode),' FoundPos=',Params.NewCodeTool.CleanPosToStr(Params.NewNode.StartPos,true),' SearchPos=',DeclarationTool.CleanPosToStr(DeclarationNode.StartPos,true));
+      if IsDeclarationNode(Node) then begin
-        if (Params.NewNode=DeclarationNode)
+        //debugln(['ReadIdentifier reference found, adding ...']);
-        or (Params.NewNode=AliasDeclarationNode) then begin
+        AddReference(IdentStartPos);
-          //debugln(['ReadIdentifier reference found, adding ...']);
+      end else if (frfMethodOverrides in Flags) and (Node.Desc=ctnProcedureHead) then
+      begin
+        {$IFDEF VerboseFindRefMethodOverrides}
+        debugln(['ReadIdentifier identifier is procedure, check overrides...']);
+        {$ENDIF}
+        if CheckMethodOverride(Node.Parent) then
           AddReference(IdentStartPos);
-        end;
       end;
     end;
   end;
@@ -7175,6 +7284,12 @@ var
       debugln(['FindReferences Has no Alias']);
     {$ENDIF}
 
+    if frfMethodOverrides in Flags then begin
+      if (AliasDeclarationNode=nil) or (AliasDeclarationNode.Desc<>ctnProcedureHead)
+          or (not NodeIsMethodDecl(AliasDeclarationNode.Parent)) then
+        Exclude(Flags,frfMethodOverrides);
+    end;
+
     // search comment in front of declaration
     //debugln(['FindDeclarationNode search comment in front: ',DeclarationTool=Self,' SkipComments=',SkipComments,' Identifier=',Identifier]);
     if (DeclarationTool=Self)
@@ -7280,6 +7395,8 @@ begin
   Params:=nil;
   PosTree:=nil;
   DeclarationFound:=false;
+  OverrideProcNodes:=[];
+  NotOverrideProcNodes:=[];
 
   ActivateGlobalWriteLock;
   try
@@ -7784,6 +7901,7 @@ end;
 function TFindDeclarationTool.FindIdentifierInClassOfMethod(
   ProcContextNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean;
 { this function is internally used by FindIdentifierInContext
+  Searches the class, and then searches in class and ancestors
 }
 var
   ClassNameAtom: TAtomPosition;
@@ -11772,6 +11890,127 @@ begin
   if Result<>nil then Result:=Result.FirstChild;
 end;
 
+function TFindDeclarationTool.FindOverridenMethodDecl(ProcNode: TCodeTreeNode): TFindContext;
+// expects and returns a ctnProcedure
+var
+  ClassNode, Node, FirstParameterNode: TCodeTreeNode;
+  Params: TFindDeclarationParams;
+  SearchParamTypes: TExprTypeList;
+  AncestorNode: Boolean;
+  Identifier, CurIdentifier: PChar;
+  CurTool: TFindDeclarationTool;
+  CompListSize: Integer;
+  ParamCompatibility: TTypeCompatibility;
+  SearchGroup, FoundGroup: TPascalMethodGroup;
+  ParamCompatibilityList: TTypeCompatibilityList;
+begin
+  Result:=Default(TFindContext);
+  if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) then exit;
+  ClassNode:=ProcNode.Parent;
+  if ClassNode.Desc in AllClassBaseSections then
+    ClassNode:=ClassNode.Parent;
+  if not (ClassNode.Desc in AllClasses) then exit;
+  if not ProcNodeHasSpecifier(ProcNode,psOverride) then exit;
+
+  Identifier:=GetProcNameIdentifier(ProcNode);
+  {$IFDEF VerboseFindRefMethodOverrides}
+  debugln(['TFindDeclarationTool.FindOverridenMethodDecl START ',GetNodeNamePath(ProcNode,true)]);
+  {$ENDIF}
+
+  Params:=TFindDeclarationParams.Create(Self,ClassNode);
+  SearchParamTypes:=nil;
+  ParamCompatibilityList:=nil;
+  try
+    CurTool:=Self;
+    while CurTool.FindAncestorOfClass(ClassNode,Params,true) do begin
+      CurTool:=Params.NewCodeTool;
+      ClassNode:=Params.NewNode;
+
+      Node:=ClassNode.LastChild;
+      while Node<>nil do begin
+        if (Node.Desc in AllClassSections)
+        and (Node.FirstChild<>nil) then begin
+          Node:=Node.LastChild;
+          continue;
+        end
+        else if Node.Desc in AllSimpleIdentifierDefinitions then begin
+          if CompareIdentifiers(@CurTool.Src[Node.StartPos],Identifier)=0 then
+            exit;
+        end else if Node.Desc=ctnProperty then begin
+          CurIdentifier:=GetPropertyNameIdentifier(Node);
+          if CompareIdentifiers(CurIdentifier,Identifier)=0 then
+            exit;
+        end else if Node.Desc=ctnProcedure then begin
+          CurIdentifier:=GetProcNameIdentifier(Node);
+          if CompareIdentifiers(CurIdentifier,Identifier)=0 then begin
+            // found ancestor method with same name
+            {$IFDEF VerboseFindRefMethodOverrides}
+            debugln(['TFindDeclarationTool.FindOverridenMethodDecl Found ',CurTool.GetNodeNamePath(Node,true)]);
+            {$ENDIF}
+            if SearchParamTypes=nil then begin
+              SearchParamTypes:=CreateParamExprListFromProcNode(ProcNode,Params);
+              CompListSize:=SizeOf(TTypeCompatibility)*SearchParamTypes.Count;
+              if CompListSize>0 then
+                GetMem(ParamCompatibilityList,CompListSize);
+            end;
+            FirstParameterNode:=CurTool.GetFirstParameterNode(Node);
+            ParamCompatibility:=
+              CurTool.IsParamExprListCompatibleToNodeList(
+                FirstParameterNode,
+                SearchParamTypes,
+                false,
+                Params,ParamCompatibilityList);
+            if ParamCompatibility=tcExact then begin
+              // param list fits -> end search
+              {$IFDEF VerboseFindRefMethodOverrides}
+              debugln(['TFindDeclarationTool.FindOverridenMethodDecl Found ',CurTool.GetNodeNamePath(Node),' params fits...']);
+              {$ENDIF}
+              if (not CurTool.ProcNodeHasSpecifier(Node,psVirtual))
+                  and (not CurTool.ProcNodeHasSpecifier(Node,psOverride)) then
+                exit;
+              SearchGroup:=ExtractProcedureGroup(ProcNode);
+              FoundGroup:=CurTool.ExtractProcedureGroup(Node);
+              if SearchGroup<>FoundGroup then
+                exit;
+              Result.Tool:=CurTool;
+              Result.Node:=Node;
+              {$IFDEF VerboseFindRefMethodOverrides}
+              debugln(['TFindDeclarationTool.FindOverridenMethodDecl Result=',CurTool.GetNodeNamePath(Node,true)]);
+              {$ENDIF}
+              exit;
+            end else begin
+              {$IFDEF VerboseFindRefMethodOverrides}
+              debugln(['TFindDeclarationTool.FindOverridenMethodDecl Found ',CurTool.GetNodeNamePath(Node,true),', but params do not fit']);
+              {$ENDIF}
+            end;
+          end;
+        end else if Node.Desc=ctnGenericType then begin
+          if (Node.FirstChild<>nil)
+          and (CompareIdentifiers(@Src[Node.FirstChild.StartPos],Identifier)=0) then
+            exit;
+        end;
+        // next
+        if Node.PriorBrother<>nil then
+          Node:=Node.PriorBrother
+        else begin
+          repeat
+            Node:=Node.Parent;
+            if Node=ClassNode then exit;
+          until Node.PriorBrother<>nil;
+          Node:=Node.PriorBrother;
+        end;
+      end;
+
+    end;
+
+  finally
+    if ParamCompatibilityList<>nil then
+      Freemem(ParamCompatibilityList);
+    SearchParamTypes.Free;
+    Params.Free;
+  end;
+end;
+
 function TFindDeclarationTool.CheckSrcIdentifier(
   Params: TFindDeclarationParams;
   const FoundContext: TFindContext): TIdentifierFoundResult;
@@ -12352,7 +12591,7 @@ begin
   {$ENDIF}
 end;
 
-function TFindDeclarationTool.CompatibilityList1IsBetter( List1,
+function TFindDeclarationTool.CompatibilityList1IsBetter(List1,
   List2: TTypeCompatibilityList; ListCount: integer): boolean;
 // List1 and List2 should only contain tcCompatible and tcExact values
 var i: integer;

components/codetools/identcompletiontool.pas

@@ -1413,7 +1413,7 @@ begin
     if (Node<>nil) and (Node.Desc in AllClassSubSections) then
       Node:=Node.Parent;
     if (Node<>nil) and (Node.Desc in AllClassBaseSections) then begin
-      //debugln(['TIdentCompletionTool.CollectAllIdentifiers Node=',Node.DescAsString,' Context=',CurrentIdentifierList.Context.Node.DescAsString,' CtxVis=',NodeDescToStr(CurrentIdentifierList.NewMemberVisibility)]);
+      //debugln(['TIdentCompletionTool.CollectAllIdentifiers Node=',Node.DescAsString,' Context=',CurrentIdentifierList.Context.Node.DescAsString,' CtxVis=',NodeDescriptionAsString(CurrentIdentifierList.NewMemberVisibility)]);
       if (CurrentIdentifierList.NewMemberVisibility<>ctnNone)
       and (CurrentIdentifierList.NewMemberVisibility<Node.Desc)
       and (FoundContext.Node.Desc

components/codetools/pascalparsertool.pas

@@ -2843,11 +2843,15 @@ begin
         ctsProcedureOrFunctionOrConstructorOrDestructor);
   end else
     IsClassProc:=false;
+
   // create node for procedure
   CreateChildNode;
   CurNode.StartPos:=StartPos;
   ProcNode:=CurNode;
   ProcNode.Desc:=ctnProcedure;
+
+  if IsClassProc then ; // todo: store
+
   if CurSection=ctnInterface then
     ProcNode.SubDesc:=ctnsForwardDeclaration;
   if UpAtomIs('FUNCTION') then

components/codetools/pascalreadertool.pas

@@ -131,6 +131,7 @@ type
         const OnIdentifier: TOnEachPRIdentifier; Data: Pointer; var Abort: boolean); // node and child nodes
     procedure ForEachIdentifier(SkipComments: boolean;
         const OnIdentifier: TOnEachPRIdentifier; Data: Pointer); // whole unit/program
+    function GetNodeNamePath(Node: TCodeTreeNode; WithLineCol: boolean = false; WithFilename: boolean = false): string; // for debugging
 
     // properties
     function ExtractPropType(PropNode: TCodeTreeNode;
@@ -198,6 +199,7 @@ type
                               Parse: boolean = true): TCodeTreeNode;
     function GetProcResultNode(ProcNode: TCodeTreeNode): TCodeTreeNode;
     function NodeIsInAMethod(Node: TCodeTreeNode): boolean;
+    function NodeIsMethodDecl(ProcNode: TCodeTreeNode): boolean;
     function NodeIsMethodBody(ProcNode: TCodeTreeNode): boolean;
     function GetMethodOfBody(Node: TCodeTreeNode): TCodeTreeNode;
     function NodeIsFunction(ProcNode: TCodeTreeNode): boolean;
@@ -881,29 +883,27 @@ begin
     ctnGenericType:
       begin
         if Result<>'' then Result:='.'+Result;
-        if (Node.Desc = ctnGenericType) then begin
+        // extract generic type param names
-          // extract generic type param names
+        if WithGenericParams then begin
-          if WithGenericParams then begin
+          ParamsNode:=Node.FirstChild.NextBrother;
-            ParamsNode:=Node.FirstChild.NextBrother;
+          Params:='';
-            Params:='';
+          while ParamsNode<>nil do begin
-            while ParamsNode<>nil do begin
+            if ParamsNode.Desc=ctnGenericParams then begin
-              if ParamsNode.Desc=ctnGenericParams then begin
+              ParamNode:=ParamsNode.FirstChild;
-                ParamNode:=ParamsNode.FirstChild;
+              while ParamNode<>nil do begin
-                while ParamNode<>nil do begin
+                if ParamNode.Desc=ctnGenericParameter then begin
-                  if ParamNode.Desc=ctnGenericParameter then begin
+                  if Params<>'' then
-                    if Params<>'' then
+                    Params:=Params+',';
-                      Params:=Params+',';
+                  Params:=Params+GetIdentifier(@Src[ParamNode.StartPos]);
-                    Params:=Params+GetIdentifier(@Src[ParamNode.StartPos]);
-                  end;
-                  ParamNode:=ParamNode.NextBrother;
                 end;
-                Result:='<'+Params+'>'+Result;
+                ParamNode:=ParamNode.NextBrother;
               end;
-              ParamsNode:=ParamsNode.NextBrother;
+              Result:='<'+Params+'>'+Result;
             end;
+            ParamsNode:=ParamsNode.NextBrother;
           end;
-          Result:=GetIdentifier(@Src[Node.FirstChild.StartPos])+Result;
         end;
+        Result:=GetIdentifier(@Src[Node.FirstChild.StartPos])+Result;
         if not WithParents then break;
       end;
     ctnParameterList:
@@ -2325,6 +2325,66 @@ begin
   end;
 end;
 
+function TPascalReaderTool.GetNodeNamePath(Node: TCodeTreeNode; WithLineCol: boolean;
+  WithFilename: boolean): string;
+
+  function ReadSrc(StartPos, EndPos: integer): string;
+  begin
+    Result:='';
+    if (StartPos<1) or (EndPos>=StartPos) then exit;
+    Result:=ReadRawPascal(@Src[StartPos],@Src[EndPos],Scanner.NestedComments,true);
+  end;
+
+var
+  s: String;
+  StartNode: TCodeTreeNode;
+  OldPos: TAtomPosition;
+  RestoreCurPos: Boolean;
+begin
+  if Node=nil then
+    exit('nil');
+
+  OldPos:=CurPos;
+  RestoreCurPos:=false;
+  StartNode:=Node;
+  Result:='';
+  repeat
+    s:='';
+    case Node.Desc of
+    ctnIdentifier:
+      s:=ReadSrc(Node.StartPos,Node.EndPos);
+    ctnTypeDefinition, ctnVarDefinition, ctnConstDefinition:
+      s:=GetIdentifier(@Src[Node.StartPos]);
+    ctnGenericType:
+      s:=ExtractClassName(Node,false,false,true);
+    ctnProcedure:
+      begin
+        RestoreCurPos:=true;
+        s:=ExtractProcName(Node,[]);
+      end;
+    ctnBeginBlock,ctnAsmBlock:
+      s:=NodeDescriptionAsString(Node.Desc);
+    ctnProgram, ctnLibrary, ctnPackage:
+      begin
+        RestoreCurPos:=true;
+        s:=ExtractSourceName;
+      end;
+    end;
+    if s<>'' then begin
+      if Result<>'' then
+        Result:='.'+Result;
+      Result:=s+Result;
+    end;
+    Node:=Node.Parent;
+  until Node=nil;
+
+  if RestoreCurPos then
+    MoveCursorToAtomPos(OldPos);
+
+  if WithLineCol then
+    Result:=Result+' at '+CleanPosToStr(StartNode.StartPos,WithFilename);
+end;
+
 function TPascalReaderTool.FindVarNode(StartNode: TCodeTreeNode;
   const UpperVarName: string; Visibility: TClassSectionVisibility
   ): TCodeTreeNode;
@@ -2855,22 +2915,29 @@ begin
   end;
 end;
 
-function TPascalReaderTool.NodeIsMethodBody(ProcNode: TCodeTreeNode): boolean;
+function TPascalReaderTool.NodeIsMethodDecl(ProcNode: TCodeTreeNode): boolean;
 begin
   Result:=false;
-  if (ProcNode<>nil) and (ProcNode.Desc=ctnProcedure)
+  if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) then
-  and (ProcNode.FirstChild<>nil) then begin
-
-    // ToDo: ppu, dcu
-
-    MoveCursorToNodeStart(ProcNode.FirstChild); // ctnProcedureHead
-    ReadNextAtom;
-    if not AtomIsIdentifier then exit;
-    ReadNextAtom;
-    if (CurPos.Flag<>cafPoint) then exit;
-    Result:=true;
     exit;
-  end;
+  if (ProcNode.Parent.Desc in AllClassBaseSections)
+  or (ProcNode.Parent.Desc in AllClasses) then
+    Result:=true;
+end;
+
+function TPascalReaderTool.NodeIsMethodBody(ProcNode: TCodeTreeNode): boolean;
+// does not check if begin/asm block is there, as it should work even
+// if there is a syntax error
+begin
+  Result:=false;
+  if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) or (ProcNode.FirstChild=nil) then
+    exit;
+  MoveCursorToNodeStart(ProcNode.FirstChild); // ctnProcedureHead
+  ReadNextAtom;
+  if not AtomIsIdentifier then exit;
+  ReadNextAtom;
+  if (CurPos.Flag<>cafPoint) then exit;
+  Result:=true;
 end;
 
 function TPascalReaderTool.GetMethodOfBody(Node: TCodeTreeNode): TCodeTreeNode;

components/codetools/tests/testbasiccodetools.pas

@@ -54,6 +54,7 @@ type
     procedure TestCompareIdentifiersCaseSensitive;
     procedure TestCompareDottedIdentifiers;
     procedure TestCompareDottedIdentifiersCaseSensitive;
+    procedure TestReadRawPascal;
     // FileProcs
     procedure TestDateToCfgStr;
     procedure TestFilenameIsMatching;
@@ -674,6 +675,36 @@ begin
   t('a.&','a.&1',0); // compares 'a.' and 'a.'
 end;
 
+procedure TTestBasicCodeTools.TestReadRawPascal;
+
+  procedure t(const Src: string; StartPos, EndPos: integer; const Expected: string;
+    NestedComments: boolean = false; SkipDirectives: boolean = true);
+  var
+    p, StartP, EndP: PChar;
+    Actual: String;
+  begin
+    p:=PChar(Src);
+    StartP:=p+StartPos-1;
+    if EndPos<StartPos then
+      EndP:=nil
+    else
+      EndP:=p+EndPos-1;
+
+    Actual:=ReadRawPascal(StartP,EndP,NestedComments,SkipDirectives);
+    if Actual=Expected then exit;
+    Fail('Src="'+DbgStr(Src)+'" StartPos='+dbgs(StartPos)+' EndPos='+dbgs(EndPos)
+      +' NestedComments='+dbgs(NestedComments)+' SkipDirectives='+dbgs(SkipDirectives)
+      +' Expected="'+DbgStr(Expected)+'" Found="'+DbgStr(Actual)+'"');
+  end;
+
+begin
+  t('a',1,2,'a');
+  t('a',1,0,'a');
+  t('a   b',1,0,'a b');
+  t('a{}b',1,0,'a b');
+  t('a.b',1,0,'a.b');
+end;
+
 procedure TTestBasicCodeTools.TestDateToCfgStr;
 
   procedure t(const Date: TDateTime; const aFormat, Expected: string);

components/codetools/tests/testrefactoring.pas

@@ -11,7 +11,7 @@ interface
 
 uses
   Classes, SysUtils, CodeToolManager, CodeCache, CodeTree, BasicCodeTools,
-  CTUnitGraph, LazLogger, LazFileUtils, AVL_Tree, fpcunit, testregistry,
+  CTUnitGraph, FindDeclarationTool, LazLogger, LazFileUtils, AVL_Tree, fpcunit, testregistry,
   TestFinddeclaration;
 
 const
@@ -22,7 +22,7 @@ type
 
   TCustomTestRefactoring = class(TCustomTestFindDeclaration)
   protected
-    procedure RenameReferences(NewIdentifier: string);
+    procedure RenameReferences(NewIdentifier: string; const Flags: TFindRefsFlags = []);
     procedure CheckDiff(CurCode: TCodeBuffer; const ExpLines: array of string);
   end;
 
@@ -41,6 +41,7 @@ type
     procedure TestRenameMethodArgDown;
     procedure TestRenameMethodArgUp;
     procedure TestRenameMethodInherited;
+    procedure TestRenameMethodWithOverrides;
     procedure TestRenameNestedProgramProcDown;
     procedure TestRenameNestedProgramProcUp;
     procedure TestRenameNestedUnitProcDown;
@@ -51,7 +52,8 @@ implementation
 
 { TCustomTestRefactoring }
 
-procedure TCustomTestRefactoring.RenameReferences(NewIdentifier: string);
+procedure TCustomTestRefactoring.RenameReferences(NewIdentifier: string; const Flags: TFindRefsFlags
+  );
 var
   Marker: TFDMarker;
   Tool: TCodeTool;
@@ -120,7 +122,7 @@ begin
 
     // search pascal source references
     if not CodeToolBoss.FindReferencesInFiles(Files,DeclCode,
-        DeclarationCaretXY,true,PascalReferences) then begin
+        DeclarationCaretXY,true,PascalReferences,Flags) then begin
       Fail('CodeToolBoss.FindReferencesInFiles failed at '+dbgs(DeclarationCaretXY)+' File='+Code.Filename);
     end;
 
@@ -642,6 +644,74 @@ begin
   '']);
 end;
 
+procedure TTestRefactoring.TestRenameMethodWithOverrides;
+begin
+  StartProgram;
+  Add([
+  'type',
+  '  TAnimal = class',
+  '    procedure Fly{#Rename}; virtual;',
+  '  end;',
+  '  TBird = class(TAnimal)',
+  '    procedure Eat;',
+  '    procedure Fly; override;',
+  '  end;',
+  '',
+  'procedure TAnimal.Fly;',
+  'begin',
+  'end;',
+  '',
+  'procedure TBird.Eat;',
+  'begin',
+  '  inherited Fly;',
+  '  Fly;',
+  'end;',
+  '',
+  'procedure TBird.Fly;',
+  'begin',
+  '  inherited Fly;',
+  '  Fly;',
+  'end;',
+  '',
+  'begin',
+  'end.',
+  '']);
+  RenameReferences('Run',[frfMethodOverrides]);
+  CheckDiff(Code,[
+  'program test1;',
+  '',
+  '{$mode objfpc}{$H+}',
+  '',
+  'type',
+  '  TAnimal = class',
+  '    procedure Run{#Rename}; virtual;',
+  '  end;',
+  '  TBird = class(TAnimal)',
+  '    procedure Eat;',
+  '    procedure Run; override;',
+  '  end;',
+  '',
+  'procedure TAnimal.Run;',
+  'begin',
+  'end;',
+  '',
+  'procedure TBird.Eat;',
+  'begin',
+  '  inherited Run;',
+  '  Run;',
+  'end;',
+  '',
+  'procedure TBird.Run;',
+  'begin',
+  '  inherited Run;',
+  '  Run;',
+  'end;',
+  '',
+  'begin',
+  'end.',
+  '']);
+end;
+
 procedure TTestRefactoring.TestRenameNestedProgramProcDown;
 begin
   StartProgram;