mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-06 11:18:10 +02:00
codetools: find references: started find method overrides
This commit is contained in:
mattias
parent
e6c486a8e7
commit
5979037e86
@ -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
|
||||
|
||||
@ -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
|
||||
): boolean;
|
||||
var Cache: TFindIdentifierReferenceCache; // you must free Cache
|
||||
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,
|
||||
Y: integer; SearchInCode: TCodeBuffer; SkipComments: boolean;
|
||||
var ListOfPCodeXYPosition: TFPList; var Cache: TFindIdentifierReferenceCache
|
||||
): boolean;
|
||||
function TCodeToolManager.FindReferences(IdentifierCode: TCodeBuffer; X, Y: integer;
|
||||
SearchInCode: TCodeBuffer; SkipComments: boolean; var ListOfPCodeXYPosition: TFPList;
|
||||
var Cache: TFindIdentifierReferenceCache; const Flags: TFindRefsFlags): 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;
|
||||
DeclarationCode: TCodeBuffer; const DeclarationCaretXY: TPoint;
|
||||
SearchInComments: boolean; var TreeOfPCodeXYPosition: TAVLTree): boolean;
|
||||
function TCodeToolManager.FindReferencesInFiles(Files: TStringList; DeclarationCode: TCodeBuffer;
|
||||
const DeclarationCaretXY: TPoint; SearchInComments: boolean; var TreeOfPCodeXYPosition: TAVLTree;
|
||||
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;
|
||||
|
||||
@ -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 }
|
||||
|
||||
|
||||
@ -337,8 +337,7 @@ type
|
||||
|
||||
// debugging
|
||||
procedure Clear; virtual;
|
||||
function NodeDescToStr(Desc: integer): string;
|
||||
function NodeSubDescToStr(Desc, SubDesc: integer): string;
|
||||
function NodeSubDescToStr(Desc: TCodeTreeNodeDesc; SubDesc: TCodeTreeNodeSubDesc): 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;
|
||||
begin
|
||||
Result:=NodeDescriptionAsString(TCodeTreeNodeDesc(Desc));
|
||||
end;
|
||||
|
||||
function TCustomCodeTool.NodeSubDescToStr(Desc, SubDesc: integer): string;
|
||||
function TCustomCodeTool.NodeSubDescToStr(Desc: TCodeTreeNodeDesc; SubDesc: TCodeTreeNodeSubDesc
|
||||
): 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)+' ');
|
||||
|
||||
@ -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.Desc = ctnSrcName) then begin
|
||||
//Node:=Node.Parent;
|
||||
MoveCursorToCleanPos(Node.StartPos);
|
||||
AnUnitName:=ExtractIdentifierWithPoints(Node.StartPos,false);
|
||||
{$IFDEF EnableFKnownIdentLength}
|
||||
if FKnownIdentLength>0 then
|
||||
delete(AnUnitName,FKnownIdentLength+1, length(AnUnitName));
|
||||
{$ENDIF}
|
||||
//AnUnitName:=GetDottedIdentifier(@Src[Node.StartPos]); //program, library, package
|
||||
NewCodeTool:=FindCodeToolForUsedUnit(AnUnitName, '',false);
|
||||
if NewCodeTool=DeclarationTool then begin
|
||||
AddReference(IdentStartPos);
|
||||
exit;
|
||||
end;
|
||||
end else
|
||||
if ( (Node.Desc=ctnUseUnit) or
|
||||
((DeclarationNode<>nil) and (Node.Parent<>nil) and (Node.Parent.Desc=ctnUseUnit)) )
|
||||
and (Params.NewCodeTool=Self)
|
||||
if Node=nil then exit;
|
||||
|
||||
if (Node.Desc = ctnSrcName) then begin
|
||||
MoveCursorToCleanPos(Node.StartPos);
|
||||
AnUnitName:=ExtractIdentifierWithPoints(Node.StartPos,false);
|
||||
{$IFDEF EnableFKnownIdentLength}
|
||||
if FKnownIdentLength>0 then
|
||||
delete(AnUnitName,FKnownIdentLength+1, length(AnUnitName));
|
||||
{$ENDIF}
|
||||
//AnUnitName:=GetDottedIdentifier(@Src[Node.StartPos]); //program, library, package
|
||||
NewCodeTool:=FindCodeToolForUsedUnit(AnUnitName, '',false);
|
||||
if NewCodeTool=DeclarationTool then begin
|
||||
AddReference(IdentStartPos);
|
||||
exit;
|
||||
end;
|
||||
end else
|
||||
if ( (Node.Desc=ctnUseUnit) or
|
||||
((DeclarationNode<>nil) and (Node.Parent<>nil) and (Node.Parent.Desc=ctnUseUnit)) )
|
||||
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
|
||||
if (DeclarationNode.Desc=ctnSrcName)
|
||||
or ((DeclarationNode.Parent<>nil) and (DeclarationNode.Parent.Desc=ctnSrcName))
|
||||
then begin
|
||||
// searching a unit reference -> check if it is the same
|
||||
MoveCursorToNodeStart(Node);
|
||||
if ReadNextUsedUnit(UnitNamePos,UnitInFilePos) then begin
|
||||
// cursor is on an used unit -> try to locate it
|
||||
MoveCursorToCleanPos(UnitNamePos.StartPos);
|
||||
ReadNextAtom;
|
||||
AnUnitName:=ExtractUsedUnitNameAtCursor(@UnitInFilename);
|
||||
NewCodeTool:=FindCodeToolForUsedUnit(AnUnitName,UnitInFilename,false);
|
||||
if NewCodeTool=DeclarationTool then begin
|
||||
AddReference(IdentStartPos);
|
||||
exit;
|
||||
end;
|
||||
// searching a unit reference -> check if it is the same
|
||||
MoveCursorToNodeStart(Node);
|
||||
if ReadNextUsedUnit(UnitNamePos,UnitInFilePos) then begin
|
||||
// cursor is on an used unit -> try to locate it
|
||||
MoveCursorToCleanPos(UnitNamePos.StartPos);
|
||||
ReadNextAtom;
|
||||
AnUnitName:=ExtractUsedUnitNameAtCursor(@UnitInFilename);
|
||||
NewCodeTool:=FindCodeToolForUsedUnit(AnUnitName,UnitInFilename,false);
|
||||
if NewCodeTool=DeclarationTool then begin
|
||||
AddReference(IdentStartPos);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
UseProcHead(Node);
|
||||
//debugln('Context=',NodePathAsString(Params.NewNode),' FoundPos=',Params.NewCodeTool.CleanPosToStr(Params.NewNode.StartPos,true),' SearchPos=',DeclarationTool.CleanPosToStr(DeclarationNode.StartPos,true));
|
||||
if (Params.NewNode=DeclarationNode)
|
||||
or (Params.NewNode=AliasDeclarationNode) then begin
|
||||
//debugln(['ReadIdentifier reference found, adding ...']);
|
||||
//debugln('Found=',Params.NewCodeTool.GetNodeNamePath(Node,true,true),' Searched=',DeclarationTool.GetNodeNamePath(DeclarationNode,true,true));
|
||||
if IsDeclarationNode(Node) then begin
|
||||
//debugln(['ReadIdentifier reference found, adding ...']);
|
||||
AddReference(IdentStartPos);
|
||||
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;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
if WithGenericParams then begin
|
||||
ParamsNode:=Node.FirstChild.NextBrother;
|
||||
Params:='';
|
||||
while ParamsNode<>nil do begin
|
||||
if ParamsNode.Desc=ctnGenericParams then begin
|
||||
ParamNode:=ParamsNode.FirstChild;
|
||||
while ParamNode<>nil do begin
|
||||
if ParamNode.Desc=ctnGenericParameter then begin
|
||||
if Params<>'' then
|
||||
Params:=Params+',';
|
||||
Params:=Params+GetIdentifier(@Src[ParamNode.StartPos]);
|
||||
end;
|
||||
ParamNode:=ParamNode.NextBrother;
|
||||
// extract generic type param names
|
||||
if WithGenericParams then begin
|
||||
ParamsNode:=Node.FirstChild.NextBrother;
|
||||
Params:='';
|
||||
while ParamsNode<>nil do begin
|
||||
if ParamsNode.Desc=ctnGenericParams then begin
|
||||
ParamNode:=ParamsNode.FirstChild;
|
||||
while ParamNode<>nil do begin
|
||||
if ParamNode.Desc=ctnGenericParameter then begin
|
||||
if Params<>'' then
|
||||
Params:=Params+',';
|
||||
Params:=Params+GetIdentifier(@Src[ParamNode.StartPos]);
|
||||
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)
|
||||
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;
|
||||
if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure) then
|
||||
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;
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user