mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 06:38:06 +02:00
codetools: started Find- and RenameSourceNameReferences
This commit is contained in:
mattias
parent
658b9adb86
commit
a8004c0845
@ -194,11 +194,13 @@ function dbgsDiff(Expected, Actual: string): string; overload;
|
||||
function DottedIdentifierLength(Identifier: PChar): integer;
|
||||
function GetDottedIdentifier(Identifier: PChar): string;
|
||||
function IsDottedIdentifier(const Identifier: string; AllowAmp: boolean = True): boolean;
|
||||
function GetDotCountInIdentifier(Identifier: PChar): integer; // -1 if not an identifier
|
||||
function CompareDottedIdentifiers(Identifier1, Identifier2: PChar): integer;
|
||||
function CompareDottedIdentifiersCaseSensitive(Identifier1, Identifier2: PChar): integer;
|
||||
function ChompDottedIdentifier(const Identifier: string): string;
|
||||
function SkipDottedIdentifierPart(var Identifier: PChar): boolean;
|
||||
function DottedIdentifierStartsWith(Identifier, StartsWithIdent: PChar): boolean; // true if equal or longer
|
||||
function DottedIdentifierEndsWith(Identifier, EndsWithIdent: PChar): boolean; // true if equal or longer
|
||||
|
||||
// space and special chars
|
||||
function TrimCodeSpace(const ACode: string): string;
|
||||
@ -602,20 +604,24 @@ function ReadDottedIdentifier(var Position: PChar; SrcEnd: PChar;
|
||||
NestedComments: boolean): string;
|
||||
var
|
||||
AtomStart, p: PChar;
|
||||
s: String;
|
||||
begin
|
||||
Result:='';
|
||||
p:=Position;
|
||||
ReadRawNextPascalAtom(p,AtomStart,SrcEnd,NestedComments);
|
||||
Position:=AtomStart;
|
||||
if (AtomStart>=p) or not IsIdentStartChar[AtomStart^] then exit;
|
||||
if (AtomStart>=p) then exit;
|
||||
Result:=GetIdentifier(AtomStart);
|
||||
if Result='' then exit;
|
||||
repeat
|
||||
Position:=p;
|
||||
ReadRawNextPascalAtom(p,AtomStart,SrcEnd,NestedComments);
|
||||
if (AtomStart+1<>p) or (AtomStart^<>'.') then exit;
|
||||
ReadRawNextPascalAtom(p,AtomStart,SrcEnd,NestedComments);
|
||||
if (AtomStart>=p) or not IsIdentStartChar[AtomStart^] then exit;
|
||||
Position:=AtomStart;
|
||||
Result:=Result+'.'+GetIdentifier(AtomStart);
|
||||
if (AtomStart>=p) then exit;
|
||||
s:=GetIdentifier(AtomStart);
|
||||
if s='' then exit;
|
||||
Result:=Result+'.'+s;
|
||||
until false;
|
||||
end;
|
||||
|
||||
@ -1869,8 +1875,18 @@ function GetIdentLen(Identifier: PChar): integer;
|
||||
begin
|
||||
Result:=0;
|
||||
if Identifier=nil then exit;
|
||||
if not IsIdentStartChar[Identifier^] then exit;
|
||||
while (IsIdentChar[Identifier[Result]]) do inc(Result);
|
||||
if not IsIdentStartChar[Identifier^] then begin
|
||||
if Identifier^='&' then begin
|
||||
inc(Identifier);
|
||||
if not IsIdentStartChar[Identifier^] then exit;
|
||||
Result:=1;
|
||||
end else
|
||||
exit;
|
||||
end;
|
||||
repeat
|
||||
inc(Result);
|
||||
inc(Identifier);
|
||||
until not IsIdentChar[Identifier^];
|
||||
end;
|
||||
|
||||
function FindFirstProcSpecifier(const ProcText: string; NestedComments: boolean
|
||||
@ -5318,20 +5334,14 @@ begin
|
||||
Result:=0;
|
||||
if Identifier=nil then exit;
|
||||
p:=Identifier;
|
||||
if p^='&' then
|
||||
inc(p);
|
||||
repeat
|
||||
if not IsIdentStartChar[p^] then exit;
|
||||
repeat
|
||||
c:=p^;
|
||||
inc(p);
|
||||
until not IsIdentChar[p^];
|
||||
if p^<>'.' then begin
|
||||
if not IsIdentChar[c] then exit;
|
||||
break;
|
||||
end;
|
||||
if p^='&' then
|
||||
inc(p);
|
||||
if not IsIdentStartChar[p^] then exit;
|
||||
inc(p);
|
||||
while IsIdentChar[p^] do inc(p);
|
||||
if p^<>'.' then
|
||||
break;
|
||||
inc(p);
|
||||
until false;
|
||||
Result:=p-Identifier;
|
||||
@ -5368,6 +5378,21 @@ begin
|
||||
Result:=(p-StartP)=length(Identifier);
|
||||
end;
|
||||
|
||||
function GetDotCountInIdentifier(Identifier: PChar): integer;
|
||||
begin
|
||||
Result:=0;
|
||||
repeat
|
||||
if Identifier^='&' then inc(Identifier);
|
||||
if not IsIdentStartChar[Identifier^] then exit;
|
||||
inc(Identifier);
|
||||
while IsIdentChar[Identifier^] do inc(Identifier);
|
||||
if Identifier^<>'.' then
|
||||
exit;
|
||||
inc(Result);
|
||||
inc(Identifier);
|
||||
until false;
|
||||
end;
|
||||
|
||||
function CompareDottedIdentifiers(Identifier1, Identifier2: PChar): integer;
|
||||
var
|
||||
c: Char;
|
||||
@ -5491,6 +5516,27 @@ begin
|
||||
Result:=not IsIdentChar[Identifier^] and not IsIdentChar[StartsWithIdent^];
|
||||
end;
|
||||
|
||||
function DottedIdentifierEndsWith(Identifier, EndsWithIdent: PChar): boolean;
|
||||
var
|
||||
IdentifierDotCnt, EndsWithIdentDotCnt: Integer;
|
||||
begin
|
||||
Result:=false;
|
||||
if (EndsWithIdent=nil) then exit;
|
||||
if not (IsIdentStartChar[EndsWithIdent^]
|
||||
or ((EndsWithIdent^='&') and IsIdentStartChar[EndsWithIdent[1]])) then
|
||||
exit;
|
||||
IdentifierDotCnt:=GetDotCountInIdentifier(Identifier);
|
||||
EndsWithIdentDotCnt:=GetDotCountInIdentifier(EndsWithIdent);
|
||||
if EndsWithIdentDotCnt>IdentifierDotCnt then
|
||||
exit;
|
||||
while IdentifierDotCnt>EndsWithIdentDotCnt do begin
|
||||
while Identifier^<>'.' do inc(Identifier);
|
||||
inc(Identifier);
|
||||
dec(IdentifierDotCnt);
|
||||
end;
|
||||
Result:=CompareDottedIdentifiers(Identifier,EndsWithIdent)=0;
|
||||
end;
|
||||
|
||||
function CompareDottedIdentifiersCaseSensitive(Identifier1, Identifier2: PChar): integer;
|
||||
var
|
||||
c: Char;
|
||||
|
||||
@ -36,7 +36,7 @@ uses
|
||||
Classes, SysUtils, Contnrs, AVL_Tree,
|
||||
// Codetools
|
||||
CodeAtom, CodeCache, FileProcs, CodeTree, ExtractProcTool, FindDeclarationTool,
|
||||
BasicCodeTools, KeywordFuncLists, LinkScanner, SourceChanger;
|
||||
BasicCodeTools, KeywordFuncLists, LinkScanner, SourceChanger, CustomCodeTool;
|
||||
|
||||
type
|
||||
TChangeParamListAction = (
|
||||
@ -65,6 +65,25 @@ type
|
||||
constructor CreateChangeDefaultValue(TheIndex: integer; aValue: string);
|
||||
end;
|
||||
|
||||
TChangeDeclarationTool = class;
|
||||
|
||||
{ TSrcNameRefs - holds the references of a source name in one module }
|
||||
|
||||
TSrcNameRefs = class
|
||||
public
|
||||
Tool: TChangeDeclarationTool;
|
||||
LocalSrcName: string;
|
||||
InFilenameCleanPos: integer;
|
||||
TreeOfPCodeXYPosition: TAVLTree;
|
||||
NewLocalSrcName: string; // for rename
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
TReplaceDottedIdentifierParam = record
|
||||
OldNames, NewNames: TStringArray;
|
||||
SameStart, SameEnd: integer;
|
||||
end;
|
||||
|
||||
{ TChangeDeclarationTool }
|
||||
|
||||
TChangeDeclarationTool = class(TExtractCodeTool)
|
||||
@ -86,6 +105,13 @@ type
|
||||
|
||||
function AddProcModifier(const CursorPos: TCodeXYPosition; aModifier: string;
|
||||
SourceChanger: TSourceChangeCache): boolean;
|
||||
|
||||
function InitReplaceDottedIdentifier(const OldDottedIdentifier, NewDottedIdentifier: string;
|
||||
out Param: TReplaceDottedIdentifierParam): boolean;
|
||||
function ReplaceDottedIdentifier(CleanPos: integer; const Param: TReplaceDottedIdentifierParam;
|
||||
SourceChanger: TSourceChangeCache): boolean;
|
||||
function RenameSourceNameReferences(OldTargetFilename, NewTargetFilename: string;
|
||||
Refs: TSrcNameRefs; SourceChanger: TSourceChangeCache): boolean;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -1051,5 +1077,189 @@ begin
|
||||
Result:=SourceChanger.Apply;
|
||||
end;
|
||||
|
||||
function TChangeDeclarationTool.InitReplaceDottedIdentifier(const OldDottedIdentifier,
|
||||
NewDottedIdentifier: string; out Param: TReplaceDottedIdentifierParam): boolean;
|
||||
|
||||
function SplitDotty(const Dotted: string; var Arr: TStringArray): boolean;
|
||||
var
|
||||
p, l, StartP: integer;
|
||||
begin
|
||||
Result:=false;
|
||||
p:=1;
|
||||
l:=length(Dotted);
|
||||
repeat
|
||||
StartP:=p;
|
||||
if p>l then exit;
|
||||
if Dotted[p]='&' then inc(p);
|
||||
if p>l then exit;
|
||||
if not IsIdentStartChar[Dotted[p]] then exit;
|
||||
inc(p);
|
||||
while (p<=l) and IsIdentChar[Dotted[p]] do inc(p);
|
||||
Insert(copy(Dotted,StartP,p-StartP),Arr,length(Arr));
|
||||
if p>l then exit(true);
|
||||
if Dotted[p]<>'.' then exit;
|
||||
inc(p);
|
||||
until false;
|
||||
end;
|
||||
|
||||
var
|
||||
OldCount, NewCount: integer;
|
||||
begin
|
||||
Result:=false;
|
||||
Param:=Default(TReplaceDottedIdentifierParam);
|
||||
if not SplitDotty(OldDottedIdentifier,Param.OldNames) then exit;
|
||||
if not SplitDotty(NewDottedIdentifier,Param.NewNames) then exit;
|
||||
|
||||
OldCount:=length(Param.OldNames);
|
||||
NewCount:=length(Param.NewNames);
|
||||
Param.SameStart:=0;
|
||||
while (Param.SameStart<OldCount)
|
||||
and (Param.SameStart<NewCount)
|
||||
and (CompareIdentifiers(PChar(Param.OldNames[Param.SameStart]),
|
||||
PChar(Param.NewNames[Param.SameStart]))=0) do
|
||||
inc(Param.SameStart);
|
||||
Param.SameEnd:=0;
|
||||
while (Param.SameEnd<OldCount)
|
||||
and (Param.SameEnd<NewCount)
|
||||
and (CompareIdentifiers(PChar(Param.OldNames[OldCount-Param.SameEnd-1]),
|
||||
PChar(Param.NewNames[NewCount-Param.SameEnd-1]))=0) do
|
||||
inc(Param.SameEnd);
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TChangeDeclarationTool.ReplaceDottedIdentifier(CleanPos: integer;
|
||||
const Param: TReplaceDottedIdentifierParam; SourceChanger: TSourceChangeCache): boolean;
|
||||
type
|
||||
TItem = record
|
||||
StartPos, EndPos: integer;
|
||||
Name: string;
|
||||
DotPos: integer;
|
||||
end;
|
||||
|
||||
function Replace(CleanStartPos, CleanEndPos: integer; const NewCode: string): boolean;
|
||||
var
|
||||
StartCodePos, EndCodePos: TCodePosition;
|
||||
OldCode: String;
|
||||
begin
|
||||
CleanPosToCodePos(CleanStartPos,StartCodePos);
|
||||
CleanPosToCodePos(CleanEndPos,EndCodePos);
|
||||
if (StartCodePos.Code<>EndCodePos.Code) or (StartCodePos.P>EndCodePos.P) then
|
||||
begin
|
||||
debugln(['Error: [20250203111039] ReplaceDottedIdentifier dotted identifier spans over multiple files: ',CleanPosToStr(CleanStartPos,true)]);
|
||||
exit(false);
|
||||
end;
|
||||
OldCode:=copy(StartCodePos.Code.Source,StartCodePos.P,EndCodePos.P-StartCodePos.P);
|
||||
{$IFDEF VerboseFindSourceNameReferences}
|
||||
debugln(['ReplaceDottedIdentifier ',CleanPosToStr(CleanStartPos),' OldCode="',OldCode,'" NewCode="',NewCode,'"']);
|
||||
{$ENDIF}
|
||||
if OldCode=NewCode then
|
||||
exit(true);
|
||||
Result:=SourceChanger.ReplaceEx(gtNone,gtNone,1,1,StartCodePos.Code,
|
||||
StartCodePos.P,EndCodePos.P, NewCode);
|
||||
if not Result then
|
||||
debugln(['Error: [20250203111611] SourceChanger.ReplaceEx failed at: ',CleanPosToStr(CleanStartPos,true)]);
|
||||
end;
|
||||
|
||||
var
|
||||
Item: TItem;
|
||||
Items: array of TItem;
|
||||
NewCode: String;
|
||||
EndPos, OldCount, NewCount, i: Integer;
|
||||
HasComments: Boolean;
|
||||
begin
|
||||
Result:=false;
|
||||
|
||||
OldCount:=length(Param.OldNames);
|
||||
NewCount:=length(Param.NewNames);
|
||||
|
||||
// parse and collect atoms
|
||||
SetLength(Items{%H-},OldCount);
|
||||
MoveCursorToCleanPos(CleanPos);
|
||||
HasComments:=false;
|
||||
for i:=0 to OldCount-1 do begin
|
||||
ReadNextAtom;
|
||||
Item.StartPos:=CurPos.StartPos;
|
||||
Item.EndPos:=CurPos.EndPos;
|
||||
Item.Name:=GetAtom;
|
||||
|
||||
if (i>0) and (Item.StartPos>Items[i-1].DotPos+1) then
|
||||
HasComments:=true;
|
||||
if CompareIdentifiers(PChar(Item.Name),PChar(Param.OldNames[i]))<>0 then begin
|
||||
debugln(['TChangeDeclarationTool.ReplaceDottedIdentifier expected "',Param.OldNames[i],'", but found "',Item.Name,'" at '+CleanPosToStr(CurPos.StartPos,true)]);
|
||||
exit;
|
||||
end;
|
||||
if i<OldCount-1 then begin
|
||||
ReadNextAtom;
|
||||
if CurPos.Flag<>cafPoint then begin
|
||||
debugln(['TChangeDeclarationTool.ReplaceDottedIdentifier expected ., but found "',GetAtom,'" at '+CleanPosToStr(CurPos.StartPos,true)]);
|
||||
exit;
|
||||
end;
|
||||
Item.DotPos:=CurPos.StartPos;
|
||||
if Item.EndPos<Item.DotPos then
|
||||
HasComments:=true;
|
||||
end;
|
||||
Items[i]:=Item;
|
||||
end;
|
||||
EndPos:=CurPos.EndPos;
|
||||
|
||||
if not HasComments then begin
|
||||
// simple replace
|
||||
NewCode:=Param.NewNames[0];
|
||||
for i:=1 to NewCount-1 do
|
||||
NewCode:=NewCode+'.'+Param.NewNames[i];
|
||||
Result:=Replace(CleanPos,EndPos,NewCode);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// ToDo:
|
||||
debugln(['TChangeDeclarationTool.ReplaceDottedIdentifier Complex: OldCode="',copy(Src,CleanPos,EndPos-CleanPos),'"']);
|
||||
end;
|
||||
|
||||
function TChangeDeclarationTool.RenameSourceNameReferences(OldTargetFilename,
|
||||
NewTargetFilename: string; Refs: TSrcNameRefs; SourceChanger: TSourceChangeCache): boolean;
|
||||
var
|
||||
i, p: Integer;
|
||||
Param: TReplaceDottedIdentifierParam;
|
||||
Node: TAVLTreeNode;
|
||||
CodePos: PCodeXYPosition;
|
||||
begin
|
||||
Result:=false;
|
||||
if Refs=nil then exit;
|
||||
|
||||
if (Refs.InFilenameCleanPos>0) and (OldTargetFilename<>NewTargetFilename) then
|
||||
begin
|
||||
// todo: change in-filename
|
||||
end;
|
||||
|
||||
{$IFDEF VerboseFindSourceNameReferences}
|
||||
debugln(['TChangeDeclarationTool.RenameSourceNameReferences ',Scanner.MainFilename,' ']);
|
||||
{$ENDIF}
|
||||
if (Refs.TreeOfPCodeXYPosition<>nil) and (Refs.TreeOfPCodeXYPosition.Count>0) then begin
|
||||
InitReplaceDottedIdentifier(Refs.LocalSrcName,Refs.NewLocalSrcName,Param);
|
||||
Node:=Refs.TreeOfPCodeXYPosition.FindLowest;
|
||||
while Node<>nil do begin
|
||||
CodePos:=PCodeXYPosition(Node.Data);
|
||||
debugln(['AAA1 TChangeDeclarationTool.RenameSourceNameReferences ',dbgs(CodePos^)]);
|
||||
if CaretToCleanPos(CodePos^,p)<>0 then begin
|
||||
debugln(['TChangeDeclarationTool.RenameSourceNameReferences invalid codepos: ',dbgs(CodePos^)]);
|
||||
end else begin
|
||||
ReplaceDottedIdentifier(p,Param,SourceChanger);
|
||||
end;
|
||||
Node:=Refs.TreeOfPCodeXYPosition.FindSuccessor(Node);
|
||||
end;
|
||||
end;
|
||||
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
{ TSrcNameRefs }
|
||||
|
||||
destructor TSrcNameRefs.Destroy;
|
||||
begin
|
||||
if TreeOfPCodeXYPosition<>nil then
|
||||
FreeTreeOfPCodeXYPosition(TreeOfPCodeXYPosition);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -75,6 +75,7 @@ type
|
||||
Flag: TCommonAtomFlag;
|
||||
end;
|
||||
PAtomPosition = ^TAtomPosition;
|
||||
TAtomPositionArray = array of TAtomPosition;
|
||||
|
||||
const
|
||||
StartAtomPosition: TAtomPosition = (StartPos:1; EndPos:1; Flag:cafNone);
|
||||
|
||||
@ -280,15 +280,14 @@ function CompareCodeXYPositions(Pos1, Pos2: PCodeXYPosition): integer;
|
||||
|
||||
function CompareCodePositions(Pos1, Pos2: PCodePosition): integer;
|
||||
|
||||
procedure AddCodePosition(var ListOfPCodeXYPosition: TFPList;
|
||||
const NewCodePos: TCodeXYPosition);
|
||||
procedure AddCodePosition(var ListOfPCodeXYPosition: TFPList; const NewCodePos: TCodeXYPosition);
|
||||
function IndexOfCodePosition(var ListOfPCodeXYPosition: TFPList;
|
||||
const APosition: PCodeXYPosition): integer;
|
||||
procedure FreeListOfPCodeXYPosition(ListOfPCodeXYPosition: TFPList);
|
||||
|
||||
function CreateTreeOfPCodeXYPosition: TAVLTree;
|
||||
procedure AddCodePosition(var TreeOfPCodeXYPosition: TAVLTree;
|
||||
const NewCodePos: TCodeXYPosition);
|
||||
function AddCodePosition(var TreeOfPCodeXYPosition: TAVLTree;
|
||||
const NewCodePos: TCodeXYPosition; Unique: boolean = true): boolean; // false if duplicate not added
|
||||
procedure FreeTreeOfPCodeXYPosition(TreeOfPCodeXYPosition: TAVLTree);
|
||||
procedure AddListToTreeOfPCodeXYPosition(SrcList: TFPList;
|
||||
DestTree: TAVLTree; ClearList, CreateCopies: boolean);
|
||||
@ -351,7 +350,7 @@ begin
|
||||
else if Pos1^.Y<Pos2^.Y then Result:=1
|
||||
else if Pos1^.Y>Pos2^.Y then Result:=-1
|
||||
else if Pos1^.X<Pos2^.X then Result:=1
|
||||
else if Pos1^.Y<Pos2^.Y then Result:=-1
|
||||
else if Pos1^.X>Pos2^.X then Result:=-1
|
||||
else Result:=0;
|
||||
end;
|
||||
|
||||
@ -408,16 +407,19 @@ begin
|
||||
Result:=TAVLTree.Create(TListSortCompare(@CompareCodeXYPositions));
|
||||
end;
|
||||
|
||||
procedure AddCodePosition(var TreeOfPCodeXYPosition: TAVLTree;
|
||||
const NewCodePos: TCodeXYPosition);
|
||||
function AddCodePosition(var TreeOfPCodeXYPosition: TAVLTree; const NewCodePos: TCodeXYPosition;
|
||||
Unique: boolean): boolean;
|
||||
var
|
||||
AddCodePos: PCodeXYPosition;
|
||||
begin
|
||||
if TreeOfPCodeXYPosition=nil then
|
||||
TreeOfPCodeXYPosition:=TAVLTree.Create(TListSortCompare(@CompareCodeXYPositions));
|
||||
TreeOfPCodeXYPosition:=TAVLTree.Create(TListSortCompare(@CompareCodeXYPositions))
|
||||
else if Unique and (TreeOfPCodeXYPosition.Find(@NewCodePos)<>nil) then
|
||||
exit(false);
|
||||
New(AddCodePos);
|
||||
AddCodePos^:=NewCodePos;
|
||||
TreeOfPCodeXYPosition.Add(AddCodePos);
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
procedure FreeTreeOfPCodeXYPosition(TreeOfPCodeXYPosition: TAVLTree);
|
||||
|
||||
@ -52,7 +52,7 @@ uses
|
||||
PPUCodeTools, LFMTrees, DirectivesTree, CodeCompletionTemplater,
|
||||
PascalParserTool, CodeToolsConfig, CustomCodeTool, FindDeclarationTool,
|
||||
IdentCompletionTool, StdCodeTools, ResourceCodeTool, CodeToolsStructs,
|
||||
CTUnitGraph, ExtractProcTool, SourceLog;
|
||||
CTUnitGraph, ExtractProcTool, SourceLog, ChangeDeclarationTool;
|
||||
|
||||
type
|
||||
TCodeToolManager = class;
|
||||
@ -561,11 +561,6 @@ type
|
||||
var ListOfPCodeXYPosition: TFPList;
|
||||
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;
|
||||
SkipComments: boolean; out UsedUnitFilename: string;
|
||||
var ListOfPCodeXYPosition: TFPList): boolean;
|
||||
function FindReferencesInFiles(Files: TStringList;
|
||||
DeclarationCode: TCodeBuffer; const DeclarationCaretXY: TPoint;
|
||||
SearchInComments: boolean;
|
||||
@ -573,6 +568,20 @@ type
|
||||
function RenameIdentifier(TreeOfPCodeXYPosition: TAVLTree;
|
||||
const OldIdentifier, NewIdentifier: string;
|
||||
DeclarationCode: TCodeBuffer; DeclarationCaretXY: PPoint): boolean;
|
||||
|
||||
function FindSourceNameReferences(TargetFilename: string;
|
||||
Files: TStringList; SkipComments: boolean;
|
||||
out ListOfSrcNameRefs: TObjectList): boolean;
|
||||
function RenameSourceNameReferences(OldFilename, NewFilename, NewSrcname: string;
|
||||
ListOfSrcNameRefs: TObjectList): boolean;
|
||||
// todo: deprecate FindUnitReferences
|
||||
function FindUnitReferences(UnitCode, TargetCode: TCodeBuffer;
|
||||
SkipComments: boolean; var ListOfPCodeXYPosition: TFPList): boolean;
|
||||
// todo: deprecate FindUsedUnitReferences
|
||||
function FindUsedUnitReferences(Code: TCodeBuffer; X, Y: integer;
|
||||
SkipComments: boolean; out UsedUnitFilename: string;
|
||||
var ListOfPCodeXYPosition: TFPList): boolean;
|
||||
|
||||
function ReplaceWord(Code: TCodeBuffer; const OldWord, NewWord: string;
|
||||
ChangeStrings: boolean): boolean;
|
||||
function RemoveIdentifierDefinition(Code: TCodeBuffer; X, Y: integer
|
||||
@ -3016,7 +3025,7 @@ begin
|
||||
if TreeOfPCodeXYPosition=nil then
|
||||
TreeOfPCodeXYPosition:=CreateTreeOfPCodeXYPosition;
|
||||
AddListToTreeOfPCodeXYPosition(ListOfPCodeXYPosition,
|
||||
TreeOfPCodeXYPosition,true,false);
|
||||
TreeOfPCodeXYPosition,true,false);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -3036,6 +3045,137 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeToolManager.FindSourceNameReferences(TargetFilename: string; Files: TStringList;
|
||||
SkipComments: boolean; out ListOfSrcNameRefs: TObjectList): boolean;
|
||||
var
|
||||
i, j, InFilenameCleanPos: Integer;
|
||||
Filename, Dir, TargetUnitName, InFilename, LocalSrcName: String;
|
||||
Code: TCodeBuffer;
|
||||
Tools, DirCachesSearch, DirCachesSkip: TFPList;
|
||||
DirCache: TCTDirectoryCache;
|
||||
TreeOfPCodeXYPosition: TAVLTree;
|
||||
Param: TSrcNameRefs;
|
||||
begin
|
||||
{$IFDEF VerboseFindSourceNameReferences}
|
||||
debugln(['TCodeToolManager.FindReferencesInFiles TargetFile="',TargetFilename,'" FileCount=',Files.Count,' SkipComments=',SkipComments]);
|
||||
{$ENDIF}
|
||||
Result:=false;
|
||||
ListOfSrcNameRefs:=nil;
|
||||
Tools:=TFPList.Create;
|
||||
DirCachesSearch:=TFPList.Create;
|
||||
DirCachesSkip:=TFPList.Create;
|
||||
try
|
||||
// search in every file
|
||||
for i:=0 to Files.Count-1 do begin
|
||||
Filename:=Files[i];
|
||||
case ExtractFileNameOnly(Filename) of
|
||||
'','.','..': continue; // invalid filename
|
||||
end;
|
||||
{$IFDEF VerboseFindSourceNameReferences}
|
||||
debugln(['TCodeToolManager.FindReferencesInFiles File ',Filename]);
|
||||
{$ENDIF}
|
||||
j:=i-1;
|
||||
while (j>=0) and (CompareFilenames(Filename,Files[j])<>0) do dec(j);
|
||||
if j>=0 then continue; // skip duplicate
|
||||
|
||||
if CompareFilenames(TargetFilename,Filename)<>0 then begin
|
||||
// check if directory has target in unitpath
|
||||
Dir:=ExtractFilePath(Filename);
|
||||
DirCache:=DirectoryCachePool.GetCache(Dir,true,false);
|
||||
if DirCachesSkip.IndexOf(DirCache)>=0 then continue;
|
||||
if DirCachesSearch.IndexOf(DirCache)<0 then begin
|
||||
TargetUnitName:=ExtractFileNameOnly(TargetFilename);
|
||||
InFilename:='';
|
||||
if DirCache.FindUnitSourceInCompletePath(TargetUnitName,InFilename,true)<>'' then
|
||||
begin
|
||||
{$IFDEF VerboseFindSourceNameReferences}
|
||||
debugln(['TCodeToolManager.FindReferencesInFiles File ',Filename,', target in unit path']);
|
||||
{$ENDIF}
|
||||
DirCachesSearch.Add(DirCache);
|
||||
end else begin
|
||||
{$IFDEF VerboseFindSourceNameReferences}
|
||||
debugln(['TCodeToolManager.FindReferencesInFiles File ',Filename,', target NOT in unit path, SKIP']);
|
||||
{$ENDIF}
|
||||
DirCachesSkip.Add(DirCache);
|
||||
continue;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Code:=LoadFile(Filename,true,false);
|
||||
if Code=nil then begin
|
||||
debugln('TCodeToolManager.FindReferencesInFiles unable to load "',Filename,'"');
|
||||
exit;
|
||||
end;
|
||||
|
||||
if not InitCurCodeTool(Code) then exit;
|
||||
|
||||
if Tools.IndexOf(FCurCodeTool)>=0 then continue;
|
||||
Tools.Add(FCurCodeTool);
|
||||
|
||||
// search references
|
||||
if not FCurCodeTool.FindSourceNameReferences(TargetFilename,SkipComments,LocalSrcName,
|
||||
InFilenameCleanPos, TreeOfPCodeXYPosition, false)
|
||||
then begin
|
||||
debugln(['TCodeToolManager.FindSourceNameReferences FindSourceNameReferences FAILED in "',Code.Filename,'"']);
|
||||
if TreeOfPCodeXYPosition<>nil then
|
||||
FreeTreeOfPCodeXYPosition(TreeOfPCodeXYPosition);
|
||||
continue;
|
||||
end;
|
||||
|
||||
{$IFDEF VerboseFindSourceNameReferences}
|
||||
if TreeOfPCodeXYPosition<>nil then
|
||||
debugln(['TCodeToolManager.FindSourceNameReferences SrcName="',LocalSrcName,'" Count=',TreeOfPCodeXYPosition.Count])
|
||||
else
|
||||
debugln(['TCodeToolManager.FindSourceNameReferences SrcName="',LocalSrcName,'" Count=0']);
|
||||
{$ENDIF}
|
||||
Param:=TSrcNameRefs.Create;
|
||||
Param.Tool:=FCurCodeTool;
|
||||
Param.LocalSrcName:=LocalSrcName;
|
||||
Param.InFilenameCleanPos:=InFilenameCleanPos;
|
||||
Param.TreeOfPCodeXYPosition:=TreeOfPCodeXYPosition;
|
||||
if ListOfSrcNameRefs=nil then
|
||||
ListOfSrcNameRefs:=TObjectList.Create(true);
|
||||
ListOfSrcNameRefs.Add(Param);
|
||||
end;
|
||||
finally
|
||||
DirCachesSearch.Free;
|
||||
DirCachesSkip.Free;
|
||||
Tools.Free;
|
||||
end;
|
||||
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TCodeToolManager.RenameSourceNameReferences(OldFilename, NewFilename,
|
||||
NewSrcname: string; ListOfSrcNameRefs: TObjectList): boolean;
|
||||
var
|
||||
i: Integer;
|
||||
Param: TSrcNameRefs;
|
||||
Tool: TChangeDeclarationTool;
|
||||
NewTargetSrcName: string;
|
||||
begin
|
||||
Result:=true;
|
||||
if (ListOfSrcNameRefs=nil) or (ListOfSrcNameRefs.Count=0) then exit;
|
||||
{$IFDEF VerboseFindSourceNameReferences}
|
||||
debugln(['TCodeToolManager.RenameSourceNameReferences OldFile="',OldFilename,'" NewFile="',NewFilename,'" NewSrcName="',NewSrcname,'" FileCount=',ListOfSrcNameRefs.Count]);
|
||||
{$ENDIF}
|
||||
ClearCurCodeTool;
|
||||
SourceChangeCache.Clear;
|
||||
for i:=0 to ListOfSrcNameRefs.Count-1 do begin
|
||||
Param:=TSrcNameRefs(ListOfSrcNameRefs[i]);
|
||||
Tool:=Param.Tool;
|
||||
if Param.NewLocalSrcName='' then
|
||||
Param.NewLocalSrcName:=NewSrcName;
|
||||
if not Tool.RenameSourceNameReferences(OldFilename,NewFilename,
|
||||
Param,SourceChangeCache) then
|
||||
begin
|
||||
debugln(['TCodeToolManager.RenameSourceNameReferences Failed: ',Tool.MainFilename]);
|
||||
end;
|
||||
end;
|
||||
Result:=SourceChangeCache.Apply;
|
||||
end;
|
||||
|
||||
function TCodeToolManager.RenameIdentifier(TreeOfPCodeXYPosition: TAVLTree; const OldIdentifier,
|
||||
NewIdentifier: string; DeclarationCode: TCodeBuffer; DeclarationCaretXY: PPoint): boolean;
|
||||
var
|
||||
@ -3139,8 +3279,9 @@ begin
|
||||
@Code.Source[IdentStartPos],PChar(Pointer(NewIdentifier)));
|
||||
IdentEndPos:=IdentStartPos+length(OldIdentifier);
|
||||
|
||||
if (UpCase(Code.Source[IdentStartPos])<>UpCase(OldIdentifier[1])) and
|
||||
((Code.Source[IdentStartPos]='&') or (OldIdentifier[1]='&')) then begin
|
||||
if (UpCase(Code.Source[IdentStartPos])<>UpCase(OldIdentifier[1]))
|
||||
and ((Code.Source[IdentStartPos]='&') or (OldIdentifier[1]='&')) then
|
||||
begin
|
||||
if OldIdentifier[1]='&' then
|
||||
dec(IdentEndPos)
|
||||
else
|
||||
|
||||
@ -87,8 +87,8 @@ const
|
||||
ctnVarArgs = 24; // macpas ... parameter
|
||||
ctnSrcName = 25; // children are ctnIdentifier
|
||||
ctnUseUnit = 26; // StartPos=unit, EndPos=unitname+inFilename, children ctnUseUnitNamespace, ctnUseUnitClearName, parent ctnUsesSection
|
||||
ctnUseUnitNamespace = 27; // <namespace>.clearname.pas, parent ctnUseUnit
|
||||
ctnUseUnitClearName = 28; // namespace.<clearname>.pas, parent ctnUseUnit
|
||||
ctnUseUnitNamespace = 27; // <namespace>.clearname, parent ctnUseUnit
|
||||
ctnUseUnitClearName = 28; // namespace.<clearname>, parent ctnUseUnit
|
||||
|
||||
ctnClass = 30;
|
||||
ctnClassInterface = 31;
|
||||
@ -197,13 +197,15 @@ const
|
||||
+[ctnGenericType,ctnGlobalProperty];
|
||||
AllPascalTypes =
|
||||
AllClasses+
|
||||
[ctnGenericType,ctnSpecialize,
|
||||
ctnIdentifier,ctnOpenArrayType,ctnRangedArrayType,
|
||||
ctnRecordCase,ctnRecordVariant,
|
||||
[ctnIdentifier{alias},
|
||||
ctnGenericType,ctnSpecialize,
|
||||
ctnOpenArrayType,ctnRangedArrayType,
|
||||
ctnProcedureType,ctnReferenceTo,
|
||||
ctnSetType,ctnRangeType,ctnEnumerationType,
|
||||
ctnEnumIdentifier,ctnLabel,ctnTypeType,ctnFileType,ctnPointerType,
|
||||
ctnClassOfType,ctnVariantType,ctnConstant];
|
||||
ctnLabel,ctnTypeType,ctnFileType,ctnPointerType,
|
||||
ctnClassOfType,ctnVariantType];
|
||||
AllPascalTypeParts = AllPascalTypes
|
||||
+[ctnEnumIdentifier,ctnConstant,ctnRecordCase,ctnRecordVariant];
|
||||
AllProcTypes = [ctnProcedureType,ctnReferenceTo];
|
||||
AllPascalStatements = [ctnBeginBlock,ctnWithStatement,ctnWithVariable,
|
||||
ctnOnBlock,ctnOnIdentifier,ctnOnStatement,
|
||||
|
||||
@ -3217,7 +3217,7 @@ end;
|
||||
|
||||
function TCustomCodeTool.ExtractDottedIdentifier(CleanStartPos: integer): string;
|
||||
begin
|
||||
Result:=GetDottedIdentifier(@Src[CleanStartPos]);
|
||||
Result:=ReadDottedIdentifier(Src,CleanStartPos,Scanner.NestedComments);
|
||||
end;
|
||||
|
||||
function TCustomCodeTool.ExtractIdentifierWithPointsOutEndPos(StartPos: integer;
|
||||
@ -3229,7 +3229,7 @@ var aLen: integer;
|
||||
begin
|
||||
Result:='';
|
||||
EndPos:=StartPos;
|
||||
if src='' then exit;
|
||||
if Src='' then exit;
|
||||
MoveCursorToCleanPos(StartPos);
|
||||
|
||||
ReadNextAtom;
|
||||
|
||||
@ -69,6 +69,7 @@ interface
|
||||
{ $DEFINE VerboseFindDeclarationAndOverload}
|
||||
{ $DEFINE VerboseFindFileAtCursor}
|
||||
{ $DEFINE VerboseFindRefMethodOverrides}
|
||||
{ $DEFINE VerboseFindSourceNameReferences}
|
||||
|
||||
{$IFDEF CTDEBUG}{$DEFINE DebugPrefix}{$ENDIF}
|
||||
{$IFDEF ShowTriedIdentifiers}{$DEFINE DebugPrefix}{$ENDIF}
|
||||
@ -79,7 +80,7 @@ uses
|
||||
{$IFDEF MEM_CHECK}
|
||||
MemCheck,
|
||||
{$ENDIF}
|
||||
Classes, SysUtils, AVL_Tree,
|
||||
Classes, SysUtils, Types, AVL_Tree,
|
||||
// LazUtils
|
||||
LazFileUtils, LazStringUtils, LazUtilities,
|
||||
// Codetools
|
||||
@ -252,9 +253,9 @@ type
|
||||
xtLongBool, // longbool
|
||||
xtQWordBool, // qwordbool
|
||||
xtBoolean8, // boolean8
|
||||
xtBoolean16, // boolean16
|
||||
xtBoolean32, // boolean32
|
||||
xtBoolean64, // boolean64
|
||||
xtBoolean16, // boolean16
|
||||
xtBoolean32, // boolean32
|
||||
xtBoolean64, // boolean64
|
||||
xtString, // string
|
||||
xtAnsiString, // ansistring
|
||||
xtShortString, // shortstring
|
||||
@ -1063,6 +1064,9 @@ type
|
||||
function FindReferences(const CursorPos: TCodeXYPosition;
|
||||
SkipComments: boolean; out ListOfPCodeXYPosition: TFPList;
|
||||
Flags: TFindRefsFlags = []): boolean;
|
||||
function FindSourceNameReferences(const TargetFilename: string; SkipComments: boolean;
|
||||
out LocalSrcName: string; out InFilenameCleanPos: integer;
|
||||
out TreeOfPCodeXYPosition: TAVLTree; SyntaxExceptions: boolean = false): boolean;
|
||||
function FindUnitReferences(UnitCode: TCodeBuffer;
|
||||
SkipComments: boolean; out ListOfPCodeXYPosition: TFPList): boolean; // searches unitname of UnitCode
|
||||
procedure FindUsedUnitReferences(const CursorPos: TCodeXYPosition;
|
||||
@ -1458,41 +1462,12 @@ end;
|
||||
|
||||
function FindContextToString(const FindContext: TFindContext;
|
||||
RelativeFilename: boolean): string;
|
||||
var
|
||||
IdentNode: TCodeTreeNode;
|
||||
begin
|
||||
Result:='';
|
||||
if FindContext.Node<>nil then begin
|
||||
Result:=Result+'Node="'+FindContext.Node.DescAsString+'"';
|
||||
IdentNode:=FindContext.Node;
|
||||
while IdentNode<>nil do begin
|
||||
if IdentNode.Desc in AllSimpleIdentifierDefinitions
|
||||
+[ctnIdentifier,ctnEnumIdentifier,ctnLabel]
|
||||
then begin
|
||||
Result:=Result+' Ident="'+
|
||||
FindContext.Tool.ExtractIdentifier(IdentNode.StartPos)+'"';
|
||||
break;
|
||||
end else if IdentNode.Desc=ctnGenericType then begin
|
||||
if IdentNode.FirstChild<>nil then
|
||||
Result:=Result+' Generic="'+
|
||||
FindContext.Tool.ExtractIdentifier(IdentNode.FirstChild.StartPos)+'"'
|
||||
else
|
||||
Result:=Result+' Generic=?';
|
||||
end else if IdentNode.Desc in [ctnProperty,ctnGlobalProperty] then begin
|
||||
Result:=Result+' PropName="'+
|
||||
FindContext.Tool.ExtractPropName(IdentNode,false)+'"';
|
||||
break;
|
||||
end else if IdentNode.Desc=ctnProcedure then begin
|
||||
Result:=Result+' Proc="'+FindContext.Tool.ExtractProcName(IdentNode,[])+'"';
|
||||
break;
|
||||
end;
|
||||
IdentNode:=IdentNode.Parent;
|
||||
end;
|
||||
if RelativeFilename then
|
||||
Result:=Result+' at "'+FindContext.Tool.CleanPosToStr(FindContext.Node.StartPos,true)+'"'
|
||||
else
|
||||
Result:=Result+' at "'+FindContext.Tool.CleanPosToRelativeStr(FindContext.Node.StartPos,'')+'"'
|
||||
end else
|
||||
if RelativeFilename then ;
|
||||
if FindContext.Node<>nil then
|
||||
Result:=FindContext.Tool.GetNodeNamePath(FindContext.Node,true,true)
|
||||
else
|
||||
Result:='nil';
|
||||
end;
|
||||
|
||||
@ -7448,6 +7423,555 @@ begin
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TFindDeclarationTool.FindSourceNameReferences(const TargetFilename: string;
|
||||
SkipComments: boolean; out LocalSrcName: string; out InFilenameCleanPos: integer; out
|
||||
TreeOfPCodeXYPosition: TAVLTree; SyntaxExceptions: boolean): boolean;
|
||||
var
|
||||
IsSelf: Boolean; // true = searching references of my program/unit name
|
||||
LocalSrcNamePos: integer;
|
||||
CleanPositions: TIntegerDynArray;
|
||||
CleanPosCount: integer;
|
||||
TargetUnitName: string; // the target file unit name, can differ from LocalSrcName
|
||||
TargetShortFilename: string;
|
||||
InterfaceUsesNode, ImplementationUsesNode: TCodeTreeNode;
|
||||
IntfUseNames, ImplUseNames: TStringArray;
|
||||
Params: TFindDeclarationParams;
|
||||
|
||||
procedure AddPos(CleanPos: integer);
|
||||
begin
|
||||
{$IFDEF VerboseFindSourceNameReferences}
|
||||
debugln([' AddPos Index=',CleanPosCount,' ',CleanPosToStr(CleanPos),' "',copy(Src,CleanPos,100),'"']);
|
||||
{$ENDIF}
|
||||
if (CleanPosCount>0) and (CleanPos<=CleanPositions[CleanPosCount-1]) then begin
|
||||
debugln([' AddPos Index=',CleanPosCount,' ',CleanPosToStr(CleanPos),' "',copy(Src,CleanPos,100),'"']);
|
||||
raise Exception.Create('20250202212016');
|
||||
end;
|
||||
|
||||
if CleanPosCount=Length(CleanPositions) then begin
|
||||
if Length(CleanPositions)<8 then
|
||||
SetLength(CleanPositions,8)
|
||||
else
|
||||
SetLength(CleanPositions,CleanPosCount*2);
|
||||
end;
|
||||
CleanPositions[CleanPosCount]:=CleanPos;
|
||||
inc(CleanPosCount);
|
||||
end;
|
||||
|
||||
procedure DeletePos(CleanPos: integer);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=CleanPosCount-1 downto 0 do
|
||||
if CleanPositions[i]=CleanPos then
|
||||
System.Delete(CleanPositions,i,1);
|
||||
end;
|
||||
|
||||
function CheckUsesSection(UsesSection: TCodeTreeNode; var UseNames: TStringArray): boolean;
|
||||
var
|
||||
Node: TCodeTreeNode;
|
||||
AUnitName, UnitInFilename: string;
|
||||
StartPos: Integer;
|
||||
Code: TCodeBuffer;
|
||||
MatchInFile, MatchUses: Boolean;
|
||||
UnitNameRange, InAtom: TAtomPosition;
|
||||
begin
|
||||
if UsesSection=nil then exit(true);
|
||||
Node:=UsesSection.FirstChild;
|
||||
if Node=nil then exit(true);
|
||||
|
||||
//debugln(['CheckUsesSection START ',CleanPosToStr(Node.StartPos)]);
|
||||
Result:=false;
|
||||
MoveCursorToNodeStart(Node);
|
||||
repeat
|
||||
ReadNextAtom; // read name
|
||||
|
||||
StartPos:=CurPos.StartPos;
|
||||
AUnitName:=ExtractUsedUnitNameAtCursor(@UnitInFilename);
|
||||
if AUnitName='' then exit;
|
||||
//debugln(['CheckUsesSection AUnitName="',AUnitName,'" InFile="',UnitInFilename,'"']);
|
||||
|
||||
Insert(AUnitName,UseNames,length(UseNames));
|
||||
|
||||
if not IsSelf then begin
|
||||
// check if uses refers to target
|
||||
|
||||
MatchInFile:=false;
|
||||
MatchUses:=false;
|
||||
if UnitInFilename<>'' then begin
|
||||
if TargetShortFilename='' then
|
||||
TargetShortFilename:=ExtractFilename(TargetFilename);
|
||||
if CompareDottedIdentifiers(PChar(ExtractFilename(UnitInFilename)),
|
||||
PChar(TargetShortFilename))=0 then
|
||||
begin
|
||||
MatchInFile:=true;
|
||||
MatchUses:=CompareDottedIdentifiers(PChar(AUnitName),PChar(TargetUnitName))=0;
|
||||
end;
|
||||
end else begin
|
||||
// Note: with scopes/namespaces like -FN, a 'uses Bar;' can use a 'foo.bar.pas'
|
||||
MatchUses:=DottedIdentifierEndsWith(PChar(TargetUnitName),PChar(AUnitName));
|
||||
end;
|
||||
|
||||
if MatchUses or MatchInFile then begin
|
||||
// search in search paths
|
||||
Code:=FindUnitSource(AUnitName,UnitInFilename,false,StartPos);
|
||||
if (Code<>nil) and (CompareFilenames(Code.Filename,TargetFilename)=0) then
|
||||
begin
|
||||
// found matching uses
|
||||
{$IFDEF VerboseFindSourceNameReferences}
|
||||
if UnitInFilename<>'' then
|
||||
debugln([' CheckUsesSection uses found ',CleanPosToStr(StartPos,true),', uses="',AUnitName,'" in "',UnitInFilename,'"'])
|
||||
else
|
||||
debugln([' CheckUsesSection uses found ',CleanPosToStr(StartPos,true),', uses="',AUnitName,'"']);
|
||||
{$ENDIF}
|
||||
if MatchUses then begin
|
||||
// matches uses
|
||||
if LocalSrcNamePos>=0 then begin
|
||||
// duplicate uses
|
||||
debugln(['Warning: [20250202120622] TFindDeclarationTool.FindSourceNameReferences duplicate uses at ',CleanPosToStr(LocalSrcNamePos,true),' and ',CleanPosToStr(StartPos)]);
|
||||
DeletePos(LocalSrcNamePos);
|
||||
end;
|
||||
LocalSrcName:=AUnitName;
|
||||
LocalSrcNamePos:=StartPos;
|
||||
AddPos(StartPos);
|
||||
end;
|
||||
if MatchInFile then begin
|
||||
// matches in-filename
|
||||
MoveCursorToCleanPos(StartPos);
|
||||
ReadNextAtom;
|
||||
ReadNextUsedUnit(UnitNameRange,InAtom);
|
||||
if InFilenameCleanPos>=0 then begin
|
||||
debugln(['Warning: [20250202122909] TFindDeclarationTool.FindSourceNameReferences duplicate uses IN filenames at ',CleanPosToStr(InFilenameCleanPos,true),' and ',CleanPosToStr(InAtom.StartPos)]);
|
||||
end;
|
||||
InFilenameCleanPos:=InAtom.StartPos;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if AtomIsChar(';') then break;
|
||||
if not AtomIsChar(',') then
|
||||
RaiseExceptionFmt(20250201102057,ctsStrExpectedButAtomFound,[';',GetAtom])
|
||||
until CurPos.StartPos>SrcLen;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
procedure FindLongestUsesName(UseNames: TStringArray; const Expr: string;
|
||||
var BestUseName: string; var BestDotCount: integer);
|
||||
var
|
||||
i, DotCount: Integer;
|
||||
ExprP, UseNameP: PChar;
|
||||
begin
|
||||
ExprP:=PChar(Expr);
|
||||
for i:=0 to length(UseNames)-1 do begin
|
||||
UseNameP:=PChar(UseNames[i]);
|
||||
if CompareIdentifiers(UseNameP,ExprP)=0 then begin
|
||||
DotCount:=GetDotCountInIdentifier(UseNameP);
|
||||
if DotCount>BestDotCount then begin
|
||||
BestDotCount:=DotCount;
|
||||
BestUseName:=UseNames[i];
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function CheckIdentifier(var p: integer): boolean;
|
||||
// check the identifier at start of an expression
|
||||
var
|
||||
StartP, Ident: PChar;
|
||||
StartPos, BestDotCount, DotCnt, LastIdentPos: Integer;
|
||||
Expr, BestUseName: String;
|
||||
CursorNode, Node: TCodeTreeNode;
|
||||
Found: Boolean;
|
||||
begin
|
||||
Result:=true;
|
||||
StartPos:=p;
|
||||
StartP:=@Src[StartPos];
|
||||
Ident:=PChar(LocalSrcName);
|
||||
if CompareIdentifiers(StartP,Ident)<>0 then begin
|
||||
inc(p,GetIdentLen(StartP));
|
||||
exit;
|
||||
end;
|
||||
|
||||
Expr:=ReadDottedIdentifier(Src,p,Scanner.NestedComments);
|
||||
//debugln([' CheckIdentifier At ',CleanPosToStr(p),' Expr="',Expr,'"']);
|
||||
|
||||
if not DottedIdentifierStartsWith(PChar(LocalSrcName),PChar(Expr)) then exit;
|
||||
|
||||
{$IFDEF VerboseFindSourceNameReferences}
|
||||
debugln([' CheckIdentifier found expression starting with LocalSrcName: "',Expr,'" at ',CleanPosToStr(StartPos,true)]);
|
||||
{$ENDIF}
|
||||
|
||||
// quick check: find the longest matching uses name
|
||||
BestUseName:='';
|
||||
BestDotCount:=0;
|
||||
if (ImplementationUsesNode<>nil) and (ImplementationUsesNode.EndPos<=StartPos) then
|
||||
FindLongestUsesName(ImplUseNames,Expr,BestUseName,BestDotCount);
|
||||
if (InterfaceUsesNode<>nil) and (InterfaceUsesNode.EndPos<=StartPos) then
|
||||
FindLongestUsesName(IntfUseNames,Expr,BestUseName,BestDotCount);
|
||||
if (BestUseName<>'')
|
||||
and (CompareDottedIdentifiers(PChar(BestUseName),PChar(LocalSrcName))<>0) then
|
||||
begin
|
||||
// a longer uses fits -> this expr does not refer to the LocalSrcName
|
||||
exit;
|
||||
end;
|
||||
|
||||
// find declaration
|
||||
{$IFDEF VerboseFindSourceNameReferences}
|
||||
debugln([' CheckIdentifier search expression "',Expr,'" at ',CleanPosToStr(StartPos,true)]);
|
||||
{$ENDIF}
|
||||
|
||||
DotCnt:=GetDotCountInIdentifier(Ident);
|
||||
MoveCursorToCleanPos(StartPos);
|
||||
repeat
|
||||
ReadNextAtom;
|
||||
if not AtomIsIdentifier then begin
|
||||
debugln(['Error: [20250202181504] FindSourceNameReferences CheckIdentifier identifier expected at ',CleanPosToStr(CurPos.StartPos,true),', but "',GetAtom,'" found']);
|
||||
exit;
|
||||
end;
|
||||
if DotCnt=0 then
|
||||
break;
|
||||
dec(DotCnt);
|
||||
ReadNextAtom;
|
||||
if CurPos.Flag<>cafPoint then begin
|
||||
debugln(['Error: [20250202181625] FindSourceNameReferences CheckIdentifier . expected at ',CleanPosToStr(CurPos.StartPos,true),', but "',GetAtom,'" found']);
|
||||
exit;
|
||||
end;
|
||||
until CurPos.StartPos>=SrcLen;
|
||||
LastIdentPos:=CurPos.StartPos;
|
||||
|
||||
CursorNode:=BuildSubTreeAndFindDeepestNodeAtPos(StartPos,true);
|
||||
if CleanPosIsDeclarationIdentifier(LastIdentPos,CursorNode) then
|
||||
exit;
|
||||
|
||||
if Params=nil then
|
||||
Params:=TFindDeclarationParams.Create(Self, CursorNode)
|
||||
else
|
||||
Params.Clear;
|
||||
Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,fdfSearchInHelpers,
|
||||
fdfIgnoreCurContextNode];
|
||||
Params.ContextNode:=CursorNode;
|
||||
//debugln([' CheckIdentifier "',copy(Src,LastIdentPos,200),'"']);
|
||||
Params.SetIdentifier(Self,@Src[LastIdentPos],@CheckSrcIdentifier);
|
||||
|
||||
// search identifier also in comments -> if not found, this is no bug
|
||||
// => silently ignore
|
||||
try
|
||||
Found:=FindDeclarationOfIdentAtParam(Params);
|
||||
except
|
||||
on E: ECodeToolError do begin
|
||||
if E.Sender<>Self then begin
|
||||
// there is an error in another unit, which prevents searching
|
||||
// stop further searching in this unit
|
||||
raise;
|
||||
end;
|
||||
// continue
|
||||
end;
|
||||
on E: Exception do
|
||||
raise;
|
||||
end;
|
||||
if not Found then exit;
|
||||
Node:=Params.NewNode;
|
||||
if Node=nil then exit;
|
||||
|
||||
{$IFDEF VerboseFindSourceNameReferences}
|
||||
debugln([' CheckIdentifier Found Node=',GetNodeNamePath(Node,true)]);
|
||||
{$ENDIF}
|
||||
if Node.Desc=ctnSrcName then begin
|
||||
if IsSelf then
|
||||
AddPos(StartPos);
|
||||
end else begin
|
||||
// todo: found uses node
|
||||
end;
|
||||
end;
|
||||
|
||||
function CheckComment(var StartPos: integer; MaxPos: integer): boolean;
|
||||
var
|
||||
c: Char;
|
||||
CommentLvl: Integer;
|
||||
InStrConst, LastTokenWasPoint, IsDirective: Boolean;
|
||||
begin
|
||||
Result:=true;
|
||||
c:=Src[StartPos];
|
||||
//debugln([' CheckComment c=',c,' "',copy(Src,StartPos,20),'"']);
|
||||
IsDirective:=false;
|
||||
case c of
|
||||
'/': inc(StartPos,2);
|
||||
'(':
|
||||
begin
|
||||
inc(StartPos,2);
|
||||
IsDirective:=(StartPos<=MaxPos) and (Src[StartPos]='$');
|
||||
end;
|
||||
'{':
|
||||
begin
|
||||
inc(StartPos);
|
||||
IsDirective:=(StartPos<=MaxPos) and (Src[StartPos]='$');
|
||||
if (StartPos<=MaxPos) and (Src[StartPos]=#3) then begin
|
||||
// codetools skip comment {#3 #3}
|
||||
inc(StartPos);
|
||||
while (StartPos<=MaxPos) do begin
|
||||
if (Src[StartPos]=#3) and (StartPos<MaxPos) and (Src[StartPos+1]='}')
|
||||
then begin
|
||||
inc(StartPos,2);
|
||||
exit;
|
||||
end;
|
||||
inc(StartPos);
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
CommentLvl:=1;
|
||||
InStrConst:=false;
|
||||
LastTokenWasPoint:=false;
|
||||
while StartPos<=MaxPos do begin
|
||||
case Src[StartPos] of
|
||||
'{':
|
||||
begin
|
||||
if (c='{') and Scanner.NestedComments then inc(CommentLvl);
|
||||
LastTokenWasPoint:=false;
|
||||
end;
|
||||
'}':
|
||||
begin
|
||||
LastTokenWasPoint:=false;
|
||||
if c='{' then begin
|
||||
dec(CommentLvl);
|
||||
if CommentLvl=0 then begin
|
||||
inc(StartPos);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
')':
|
||||
begin
|
||||
LastTokenWasPoint:=false;
|
||||
if (c='(') and (Src[StartPos-1]='*') then begin
|
||||
inc(StartPos);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
'a'..'z','A'..'Z','_','&':
|
||||
begin
|
||||
if (not IsDirective) and (not SkipComments) and (not InStrConst)
|
||||
and (not LastTokenWasPoint) then
|
||||
if not CheckIdentifier(StartPos) then exit(false);
|
||||
LastTokenWasPoint:=false;
|
||||
end;
|
||||
'''':
|
||||
begin
|
||||
InStrConst:=not InStrConst;
|
||||
LastTokenWasPoint:=false;
|
||||
end;
|
||||
#10,#13:
|
||||
begin
|
||||
InStrConst:=false;
|
||||
if c='/' then begin
|
||||
inc(StartPos);
|
||||
if (StartPos<=MaxPos) and (Src[StartPos] in [#10,#13])
|
||||
and (Src[StartPos-1]<>Src[StartPos]) then
|
||||
inc(StartPos);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
' ',#9: ;
|
||||
'.': LastTokenWasPoint:=true;
|
||||
else
|
||||
LastTokenWasPoint:=false;
|
||||
end;
|
||||
inc(StartPos);
|
||||
end;
|
||||
end;
|
||||
|
||||
function CheckSource(MinPos, MaxPos: integer): boolean;
|
||||
var
|
||||
StartPos: Integer;
|
||||
LastTokenWasPoint, LastCommentTokenWasPoint: Boolean;
|
||||
begin
|
||||
Result:=true;
|
||||
if MinPos<LocalSrcNamePos then
|
||||
MinPos:=LocalSrcNamePos;
|
||||
if MinPos>SrcLen then exit;
|
||||
if MaxPos>SrcLen then MaxPos:=SrcLen+1;
|
||||
//debugln([' CheckSource ',MinPos,'..',MaxPos]);
|
||||
StartPos:=MinPos;
|
||||
LastTokenWasPoint:=false;
|
||||
while StartPos<=MaxPos do begin
|
||||
case Src[StartPos] of
|
||||
' ',#9,#10,#13:
|
||||
inc(StartPos);
|
||||
|
||||
'{':
|
||||
CheckComment(StartPos,MaxPos);
|
||||
|
||||
'/': // Delphi comment
|
||||
if (Src[StartPos+1]<>'/') then begin
|
||||
inc(StartPos);
|
||||
LastTokenWasPoint:=false;
|
||||
end else begin
|
||||
if not CheckComment(StartPos,MaxPos) then exit(false);
|
||||
end;
|
||||
|
||||
'(': // turbo pascal comment
|
||||
if (Src[StartPos+1]<>'*') then begin
|
||||
inc(StartPos);
|
||||
LastTokenWasPoint:=false;
|
||||
end else begin
|
||||
if not CheckComment(StartPos,MaxPos) then exit(false);
|
||||
end;
|
||||
|
||||
'''':
|
||||
begin
|
||||
// skip string constant
|
||||
inc(StartPos);
|
||||
while (StartPos<=MaxPos) do begin
|
||||
if (not (Src[StartPos] in ['''',#10,#13])) then
|
||||
inc(StartPos)
|
||||
else begin
|
||||
inc(StartPos);
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
LastTokenWasPoint:=false;
|
||||
end;
|
||||
|
||||
'a'..'z','A'..'Z','_','&':
|
||||
begin
|
||||
if not LastTokenWasPoint then
|
||||
if not CheckIdentifier(StartPos) then exit;
|
||||
LastTokenWasPoint:=false;
|
||||
end;
|
||||
|
||||
'.':
|
||||
begin
|
||||
LastTokenWasPoint:=true;
|
||||
inc(StartPos);
|
||||
end;
|
||||
|
||||
else
|
||||
LastTokenWasPoint:=false;
|
||||
inc(StartPos);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CreateTree;
|
||||
var
|
||||
i, p: Integer;
|
||||
CodePos: TCodeXYPosition;
|
||||
Node: TAVLTreeNode;
|
||||
begin
|
||||
for i:=0 to CleanPosCount-1 do begin
|
||||
p:=CleanPositions[i];
|
||||
if not CleanPosToCaret(p,CodePos) then
|
||||
raise Exception.Create('20250203105516');
|
||||
//debugln(['TFindDeclarationTool.FindSourceNameReferences CreateTree ',dbgs(CodePos)]);
|
||||
AddCodePosition(TreeOfPCodeXYPosition,CodePos);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
NamePos: TAtomPosition;
|
||||
MySrcName: String;
|
||||
StartPos, MaxPos: Integer;
|
||||
begin
|
||||
Result:=false;
|
||||
{$IFDEF VerboseFindSourceNameReferences}
|
||||
debugln(['TFindDeclarationTool.FindSourceNameReferences Self="',Scanner.MainFilename,'" TargetFile="',TargetFilename,'" SkipComments=',SkipComments,' SyntaxExceptions=',SyntaxExceptions]);
|
||||
{$ENDIF}
|
||||
LocalSrcName:='';
|
||||
LocalSrcNamePos:=-1;
|
||||
InFilenameCleanPos:=-1;
|
||||
TreeOfPCodeXYPosition:=nil;
|
||||
|
||||
TargetUnitName:=ExtractFileNameOnly(TargetFilename);
|
||||
MySrcName:='';
|
||||
IntfUseNames:=[];
|
||||
ImplUseNames:=[];
|
||||
CleanPosCount:=0;
|
||||
CleanPositions:=[];
|
||||
|
||||
IsSelf:=CompareFilenames(Scanner.MainFilename,TargetFilename)=0;
|
||||
if not IsSelf then begin
|
||||
if not IsValidDottedIdent(TargetUnitName) then begin
|
||||
debugln(['Error: TFindDeclarationTool.FindSourceNameReferences invalid unit file name: "',TargetFilename,'"']);
|
||||
exit(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
BuildTree(lsrEnd);
|
||||
Result:=true;
|
||||
|
||||
//debugln(['TFindDeclarationTool.FindSourceNameReferences IsSelf=',IsSelf]);
|
||||
if GetSourceNamePos(NamePos) then begin
|
||||
MySrcName:=ExtractSourceName;
|
||||
if IsSelf then begin
|
||||
LocalSrcName:=MySrcName;
|
||||
LocalSrcNamePos:=NamePos.StartPos;
|
||||
AddPos(LocalSrcNamePos);
|
||||
end;
|
||||
end else begin
|
||||
// program has no source name
|
||||
MySrcName:=ExtractFileNameOnly(Scanner.MainFilename);
|
||||
if not IsValidDottedIdent(MySrcName) then begin
|
||||
MySrcName:='';
|
||||
if IsSelf then begin
|
||||
debugln(['TFindDeclarationTool.FindSourceNameReferences program has no pascal name -> nothing to do']);
|
||||
exit(true);
|
||||
end;
|
||||
end;
|
||||
if IsSelf then
|
||||
LocalSrcName:=MySrcName;
|
||||
end;
|
||||
//debugln(['TFindDeclarationTool.FindSourceNameReferences MySrcName=',MySrcName]);
|
||||
|
||||
InterfaceUsesNode:=FindMainUsesNode;
|
||||
if not CheckUsesSection(InterfaceUsesNode,IntfUseNames) then
|
||||
exit; // syntax error
|
||||
|
||||
ImplementationUsesNode:=FindImplementationUsesNode;
|
||||
if not CheckUsesSection(ImplementationUsesNode,ImplUseNames) then
|
||||
exit; // syntax error
|
||||
|
||||
if (LocalSrcNamePos<0) and not IsSelf then begin
|
||||
{$IFDEF VerboseFindSourceNameReferences}
|
||||
debugln(['TFindDeclarationTool.FindSourceNameReferences Unit not used']);
|
||||
{$ENDIF}
|
||||
exit; // unit not used
|
||||
end;
|
||||
|
||||
MaxPos:=Tree.FindLastPosition;
|
||||
if MaxPos>SrcLen then MaxPos:=SrcLen;
|
||||
|
||||
// find references in source
|
||||
Params:=nil;
|
||||
try
|
||||
if InterfaceUsesNode<>nil then begin
|
||||
if ImplementationUsesNode<>nil then begin
|
||||
if not CheckSource(InterfaceUsesNode.EndPos,ImplementationUsesNode.StartPos) then exit;
|
||||
if not CheckSource(ImplementationUsesNode.EndPos,MaxPos) then exit;
|
||||
end else begin
|
||||
if not CheckSource(InterfaceUsesNode.EndPos,MaxPos) then exit;
|
||||
end;
|
||||
end else if IsSelf then begin
|
||||
if LocalSrcNamePos>0 then
|
||||
StartPos:=NamePos.EndPos
|
||||
else
|
||||
StartPos:=1;
|
||||
if ImplementationUsesNode<>nil then begin
|
||||
if not CheckSource(StartPos,ImplementationUsesNode.StartPos) then exit;
|
||||
if not CheckSource(ImplementationUsesNode.EndPos,MaxPos) then exit;
|
||||
end else begin
|
||||
if not CheckSource(StartPos,SrcLen) then exit;
|
||||
end;
|
||||
end else begin
|
||||
if not CheckSource(ImplementationUsesNode.EndPos,MaxPos) then exit;
|
||||
end;
|
||||
finally
|
||||
Params.Free;
|
||||
CreateTree;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFindDeclarationTool.FindUnitReferences(UnitCode: TCodeBuffer;
|
||||
SkipComments: boolean; out ListOfPCodeXYPosition: TFPList): boolean;
|
||||
var
|
||||
@ -9690,7 +10214,7 @@ var
|
||||
if Node.Desc in [ctnTypeDefinition,ctnGenericType] then begin
|
||||
FlagCanBeForwardDefined:=true;
|
||||
break;
|
||||
end else if not (Node.Desc in AllPascalTypes) then
|
||||
end else if not (Node.Desc in AllPascalTypeParts) then
|
||||
break;
|
||||
Node:=Node.Parent;
|
||||
end;
|
||||
@ -12973,39 +13497,39 @@ procedure TFindDeclarationTool.OnFindUsedUnitIdentifier(
|
||||
var
|
||||
Identifier: PChar;
|
||||
CacheEntry: PInterfaceIdentCacheEntry;
|
||||
refs: TFindUsedUnitReferences;
|
||||
Refs: TFindUsedUnitReferences;
|
||||
Found: Boolean;
|
||||
ReferencePos: TCodeXYPosition;
|
||||
begin
|
||||
if Range=epriInDirective then exit;
|
||||
if not (Node.Desc in (AllPascalTypes+AllPascalStatements)) then exit;
|
||||
if not (Node.Desc in (AllPascalTypeParts+AllPascalStatements)) then exit;
|
||||
Identifier:=@Src[IdentifierCleanPos];
|
||||
refs:=TFindUsedUnitReferences(Data);
|
||||
CacheEntry:=refs.TargetTool.FInterfaceIdentifierCache.FindIdentifier(Identifier);
|
||||
Refs:=TFindUsedUnitReferences(Data);
|
||||
CacheEntry:=Refs.TargetTool.FInterfaceIdentifierCache.FindIdentifier(Identifier);
|
||||
//debugln(['TFindUsedUnitReferences.OnIdentifier Identifier=',GetIdentifier(Identifier),' Found=',CacheEntry<>nil]);
|
||||
if (CacheEntry=nil)
|
||||
and (CompareIdentifiers(Identifier,PChar(refs.TargetUnitName))<>0) then
|
||||
and (CompareIdentifiers(Identifier,PChar(Refs.TargetUnitName))<>0) then
|
||||
exit;
|
||||
Sender.MoveCursorToCleanPos(IdentifierCleanPos);
|
||||
Sender.ReadPriorAtom;
|
||||
if (Sender.CurPos.Flag=cafPoint) or (Sender.UpAtomIs('inherited')) then exit;
|
||||
//debugln(['TFindUsedUnitReferences.OnIdentifier Identifier=',GetIdentifier(Identifier),' at begin of term']);
|
||||
// find declaration
|
||||
refs.Params.Clear;
|
||||
refs.Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,
|
||||
Refs.Params.Clear;
|
||||
Refs.Params.Flags:=[fdfSearchInParentNodes,fdfSearchInAncestors,
|
||||
fdfIgnoreCurContextNode];
|
||||
refs.Params.ContextNode:=Node;
|
||||
Refs.Params.ContextNode:=Node;
|
||||
//debugln(copy(Src,Params.ContextNode.StartPos,200));
|
||||
refs.Params.SetIdentifier(Self,Identifier,@CheckSrcIdentifier);
|
||||
Refs.Params.SetIdentifier(Self,Identifier,@CheckSrcIdentifier);
|
||||
|
||||
if Range=epriInCode then begin
|
||||
// search identifier in code
|
||||
Found:=FindDeclarationOfIdentAtParam(refs.Params);
|
||||
Found:=FindDeclarationOfIdentAtParam(Refs.Params);
|
||||
end else begin
|
||||
// search identifier in comment -> if not found, this is no problem
|
||||
// => silently ignore
|
||||
try
|
||||
Found:=FindDeclarationOfIdentAtParam(refs.Params);
|
||||
Found:=FindDeclarationOfIdentAtParam(Refs.Params);
|
||||
except
|
||||
on E: ECodeToolError do begin
|
||||
// continue
|
||||
@ -13019,7 +13543,7 @@ begin
|
||||
if not Found then exit;
|
||||
|
||||
if CleanPosToCaret(IdentifierCleanPos,ReferencePos) then
|
||||
AddCodePosition(refs.ListOfPCodeXYPosition,ReferencePos);
|
||||
AddCodePosition(Refs.ListOfPCodeXYPosition,ReferencePos);
|
||||
end;
|
||||
|
||||
function TFindDeclarationTool.FindNthParameterNode(Node: TCodeTreeNode;
|
||||
|
||||
@ -2351,10 +2351,15 @@ begin
|
||||
case Node.Desc of
|
||||
ctnIdentifier:
|
||||
s:=ReadSrc(Node.StartPos,Node.EndPos);
|
||||
ctnTypeDefinition, ctnVarDefinition, ctnConstDefinition:
|
||||
ctnTypeDefinition, ctnVarDefinition, ctnConstDefinition, ctnLabel, ctnEnumIdentifier:
|
||||
s:=GetIdentifier(@Src[Node.StartPos]);
|
||||
ctnGenericType:
|
||||
s:=ExtractClassName(Node,false,false,true);
|
||||
s:='generic-'+ExtractClassName(Node,false,false,true);
|
||||
ctnProperty,ctnGlobalProperty:
|
||||
begin
|
||||
RestoreCurPos:=true;
|
||||
s:=ExtractPropName(Node,false)
|
||||
end;
|
||||
ctnProcedure:
|
||||
begin
|
||||
RestoreCurPos:=true;
|
||||
@ -2421,7 +2426,7 @@ begin
|
||||
Result:=Result.NextBrother;
|
||||
if Result=nil then exit;
|
||||
end;
|
||||
if (not (Result.Desc in AllPascalTypes)) then
|
||||
if (not (Result.Desc in AllPascalTypeParts)) then
|
||||
Result:=nil;
|
||||
exit;
|
||||
end;
|
||||
@ -3690,6 +3695,7 @@ begin
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.ExtractUsedUnitNameAtCursor(InFilename: PAnsiString): string;
|
||||
// after reading CurPos is on atom behind, i.e. comma or semicolon
|
||||
begin
|
||||
Result:='';
|
||||
if InFilename<>nil then
|
||||
@ -3697,8 +3703,7 @@ begin
|
||||
while CurPos.Flag=cafWord do begin
|
||||
if Result<>'' then
|
||||
Result:=Result+'.';
|
||||
//Result:=Result+GetAtomIdentifier;
|
||||
Result:=Result+GetAtom;//&-ident allowed - preferred "&begin.&end" over "begin.end"
|
||||
Result:=Result+GetAtom; // read with &
|
||||
ReadNextAtom;
|
||||
if CurPos.Flag<>cafPoint then break;
|
||||
ReadNextAtom;
|
||||
|
||||
@ -5307,7 +5307,7 @@ begin
|
||||
Node:=FindDeepestNodeAtPos(CleanCursorPos,false);
|
||||
//if Node<>nil then debugln(['TStandardCodeTool.FindBlockStart ',Node.DescAsString]);
|
||||
if (Node=nil)
|
||||
or (Node.Desc in (AllPascalStatements+AllPascalTypes-AllClasses))
|
||||
or (Node.Desc in (AllPascalStatements+AllPascalTypeParts-AllClasses))
|
||||
or (Src[CurPos.StartPos] in [')',']','}'])
|
||||
then begin
|
||||
MinPos:=1;
|
||||
|
||||
@ -54,6 +54,7 @@ type
|
||||
procedure TestCompareIdentifiersCaseSensitive;
|
||||
procedure TestCompareDottedIdentifiers;
|
||||
procedure TestCompareDottedIdentifiersCaseSensitive;
|
||||
procedure TestDottedIdentifierEndsWith;
|
||||
procedure TestReadRawPascal;
|
||||
// FileProcs
|
||||
procedure TestDateToCfgStr;
|
||||
@ -675,6 +676,35 @@ begin
|
||||
t('a.&','a.&1',0); // compares 'a.' and 'a.'
|
||||
end;
|
||||
|
||||
procedure TTestBasicCodeTools.TestDottedIdentifierEndsWith;
|
||||
|
||||
procedure t(Identifier, EndsWithIdent: PChar; Expected: boolean);
|
||||
var
|
||||
Actual: Boolean;
|
||||
begin
|
||||
Actual:=DottedIdentifierEndsWith(Identifier,EndsWithIdent);
|
||||
if Actual=Expected then exit;
|
||||
Fail('Expected '+dbgs(Expected)+' for Identifier="'+Identifier+'" EndsWithIdent="'+EndsWithIdent+'"');
|
||||
end;
|
||||
|
||||
begin
|
||||
t('','',false);
|
||||
t('a','',false);
|
||||
t('','b',false);
|
||||
t('a','$',false);
|
||||
t('$','b',false);
|
||||
t('a','a',true);
|
||||
t('a','ab',false);
|
||||
t('ab','a',false);
|
||||
t('ab','ab',true);
|
||||
t('a.b','a',false);
|
||||
t('a.b','b',true);
|
||||
t('a.b.c','c',true);
|
||||
t('a.b.c','b.c',true);
|
||||
t('a.b.c','a.b.c',true);
|
||||
t('a.b.&c','&b.c',true);
|
||||
end;
|
||||
|
||||
procedure TTestBasicCodeTools.TestReadRawPascal;
|
||||
|
||||
procedure t(const Src: string; StartPos, EndPos: integer; const Expected: string;
|
||||
|
||||
@ -10,8 +10,8 @@ unit TestRefactoring;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, CodeToolManager, CodeCache, CodeTree, BasicCodeTools,
|
||||
CTUnitGraph, FindDeclarationTool, LazLogger, LazFileUtils, AVL_Tree, fpcunit, testregistry,
|
||||
Classes, SysUtils, CodeToolManager, CodeCache, CodeTree, BasicCodeTools, CTUnitGraph,
|
||||
FindDeclarationTool, LazLogger, LazFileUtils, AVL_Tree, Contnrs, fpcunit, testregistry,
|
||||
TestFinddeclaration;
|
||||
|
||||
const
|
||||
@ -23,6 +23,7 @@ type
|
||||
TCustomTestRefactoring = class(TCustomTestFindDeclaration)
|
||||
protected
|
||||
procedure RenameReferences(NewIdentifier: string; const Flags: TFindRefsFlags = []);
|
||||
procedure RenameSourceName(NewName, NewFilename: string);
|
||||
procedure CheckDiff(CurCode: TCodeBuffer; const ExpLines: array of string);
|
||||
end;
|
||||
|
||||
@ -30,24 +31,46 @@ type
|
||||
|
||||
TTestRefactoring = class(TCustomTestRefactoring)
|
||||
private
|
||||
protected
|
||||
published
|
||||
procedure TestExplodeWith;
|
||||
procedure TestRenameReferences;
|
||||
|
||||
procedure TestRenameProcReferences;
|
||||
procedure TestRenameProcedureArg;
|
||||
procedure TestRenameProcedureArgCaseSensitive;
|
||||
procedure TestRenameForwardProcedureArgDown;
|
||||
procedure TestRenameForwardProcedureArgUp;
|
||||
|
||||
procedure TestRenameMethodArgDown;
|
||||
procedure TestRenameMethodArgUp;
|
||||
procedure TestRenameMethodInherited;
|
||||
procedure TestRenameMethodWithOverrides;
|
||||
procedure TestRenameMethodWithOverridesOtherUnit;
|
||||
procedure TestRenameClassMethodWithOverrides;
|
||||
|
||||
procedure TestRenameNestedProgramProcDown;
|
||||
procedure TestRenameNestedProgramProcUp;
|
||||
procedure TestRenameNestedUnitProcDown;
|
||||
|
||||
procedure TestRenameTypeToAmp;
|
||||
|
||||
// rename program
|
||||
procedure TestRenameProgramName_Amp;
|
||||
procedure TestRenameProgramName_DottedPostfix; // todo
|
||||
|
||||
// rename uses
|
||||
// todo: rename unit &Type to &End
|
||||
// todo: rename unit Foo.Bar to Foo.Red
|
||||
// todo: rename unit Foo.Bar to Red.Bar
|
||||
// todo: rename unit Foo to Foo.Bar
|
||||
// todo: rename unit Foo.Bar to Foo
|
||||
// todo: rename unit Foo.Bar to Bar
|
||||
// todo: search in an include file should not stop searching in other files
|
||||
// todo: missing used unit should not stop searching in other files
|
||||
// todo: rename with ifdefs
|
||||
// todo: rename with -FN, unit Foo.Bar to Foo.Red, uses Bar;
|
||||
// todo: rename a.b->c.d must not change { a.}b
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -108,7 +131,7 @@ begin
|
||||
try
|
||||
Files.Add(DeclCode.Filename);
|
||||
if CompareFilenames(DeclCode.Filename,Code.Filename)<>0 then
|
||||
Files.Add(DeclCode.Filename);
|
||||
Files.Add(Code.Filename);
|
||||
|
||||
Graph:=CodeToolBoss.CreateUsesGraph;
|
||||
Graph.AddStartUnit(Code.Filename);
|
||||
@ -143,6 +166,34 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomTestRefactoring.RenameSourceName(NewName, NewFilename: string);
|
||||
var
|
||||
Files: TStringList;
|
||||
ListOfSrcNameRefs: TObjectList;
|
||||
begin
|
||||
// create the file list
|
||||
ListOfSrcNameRefs:=nil;
|
||||
Files:=TStringList.Create;
|
||||
try
|
||||
Files.Add(Code.Filename);
|
||||
|
||||
// search pascal source references
|
||||
if not CodeToolBoss.FindSourceNameReferences(Code.Filename,Files,false,ListOfSrcNameRefs) then
|
||||
begin
|
||||
Fail('CodeToolBoss.FindSourceNameReferences failed File='+Code.Filename);
|
||||
end;
|
||||
|
||||
// todo: check for conflicts
|
||||
|
||||
if not CodeToolBoss.RenameSourceNameReferences(Code.Filename,NewFilename,NewName,ListOfSrcNameRefs)
|
||||
then
|
||||
Fail('CodeToolBoss.RenameSourceNameReferences failed');
|
||||
finally
|
||||
ListOfSrcNameRefs.Free;
|
||||
Files.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomTestRefactoring.CheckDiff(CurCode: TCodeBuffer;
|
||||
const ExpLines: array of string);
|
||||
var
|
||||
@ -1167,6 +1218,54 @@ begin
|
||||
'']);
|
||||
end;
|
||||
|
||||
procedure TTestRefactoring.TestRenameProgramName_Amp;
|
||||
begin
|
||||
Add([
|
||||
'program test1;',
|
||||
'{$mode objfpc}{$H+}',
|
||||
'type TRed = word;',
|
||||
'var c: test1 . TRed;',
|
||||
'begin',
|
||||
' test1.c:=&test1 . &c;',
|
||||
'end.',
|
||||
'']);
|
||||
RenameSourceName('&End','end.pas');
|
||||
CheckDiff(Code,[
|
||||
'program &End;',
|
||||
'{$mode objfpc}{$H+}',
|
||||
'type TRed = word;',
|
||||
'var c: &End . TRed;',
|
||||
'begin',
|
||||
' &End.c:=&End . &c;',
|
||||
'end.',
|
||||
'']);
|
||||
end;
|
||||
|
||||
procedure TTestRefactoring.TestRenameProgramName_DottedPostfix;
|
||||
begin
|
||||
exit;
|
||||
|
||||
Add([
|
||||
'program Foo.Bar;',
|
||||
'{$mode objfpc}{$H+}',
|
||||
'type TRed = word;',
|
||||
'var c: foo . bar . TRed;',
|
||||
'begin',
|
||||
' foo.bar.c:=&foo . &bar . &c;',
|
||||
'end.',
|
||||
'']);
|
||||
RenameSourceName('Foo.&End','foo.end.pas');
|
||||
CheckDiff(Code,[
|
||||
'program Foo.&End;',
|
||||
'{$mode objfpc}{$H+}',
|
||||
'type TRed = word;',
|
||||
'var c: Foo . &End . TRed;',
|
||||
'begin',
|
||||
' Foo.&End.c:=Foo . &End . &c;',
|
||||
'end.',
|
||||
'']);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTests([TTestRefactoring]);
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user