mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-05 03:25:14 +02:00
918 lines
32 KiB
ObjectPascal
918 lines
32 KiB
ObjectPascal
{
|
|
Test with:
|
|
./testcodetools --suite=TTestFindDeclaration
|
|
./testcodetools --suite=TestFindDeclaration_Basic
|
|
./testcodetools --suite=TestFindDeclaration_ClassOf
|
|
./testcodetools --suite=TestFindDeclaration_With
|
|
./testcodetools --suite=TestFindDeclaration_NestedClasses
|
|
./testcodetools --suite=TestFindDeclaration_ClassHelper
|
|
./testcodetools --suite=TestFindDeclaration_TypeHelper
|
|
./testcodetools --suite=TestFindDeclaration_ObjCClass
|
|
./testcodetools --suite=TestFindDeclaration_ObjCCategory
|
|
./testcodetools --suite=TestFindDeclaration_Generics
|
|
./testcodetools --suite=TestFindDeclaration_FileAtCursor
|
|
|
|
FPC tests:
|
|
./testcodetools --suite=TestFindDeclaration_FPCTests
|
|
./testcodetools --suite=TestFindDeclaration_FPCTests --filemask=t*.pp
|
|
./testcodetools --suite=TestFindDeclaration_FPCTests --filemask=tchlp41.pp
|
|
Laz tests:
|
|
./testcodetools --suite=TestFindDeclaration_LazTests
|
|
./testcodetools --suite=TestFindDeclaration_LazTests --filemask=t*.pp
|
|
./testcodetools --suite=TestFindDeclaration_LazTests --filemask=tdefaultproperty1.pp
|
|
}
|
|
unit TestFindDeclaration;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
{off $define VerboseFindDeclarationTests}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, contnrs,
|
|
fpcunit, testregistry,
|
|
FileProcs, LazFileUtils, LazLogger,
|
|
CodeToolManager, ExprEval, CodeCache, BasicCodeTools,
|
|
CustomCodeTool, CodeTree, FindDeclarationTool, KeywordFuncLists,
|
|
IdentCompletionTool, TestPascalParser;
|
|
|
|
const
|
|
MarkDecl = '#'; // a declaration, must be unique
|
|
MarkRef = '@'; // a reference to a declaration
|
|
|
|
type
|
|
TFDMarker = class
|
|
public
|
|
Name: string;
|
|
Kind: char;
|
|
NameStartPos, NameEndPos: integer; // identifier in front of comment
|
|
CleanPos: integer; // comment end
|
|
end;
|
|
|
|
{ TCustomTestFindDeclaration }
|
|
|
|
TCustomTestFindDeclaration = class(TCustomTestPascalParser)
|
|
private
|
|
FMainCode: TCodeBuffer;
|
|
FMarkers: TObjectList;// list of TFDMarker
|
|
FMainTool: TCodeTool;
|
|
function GetMarkers(Index: integer): TFDMarker;
|
|
protected
|
|
procedure SetUp; override;
|
|
procedure TearDown; override;
|
|
function MarkerCount: integer;
|
|
property Markers[Index: integer]: TFDMarker read GetMarkers;
|
|
function AddMarker(const aName: string; Kind: char; CleanPos: integer;
|
|
NameStartPos, NameEndPos: integer): TFDMarker;
|
|
function IndexOfMarker(const aName: string; Kind: char): integer;
|
|
procedure ParseSimpleMarkers(aCode: TCodeBuffer);
|
|
function FindMarker(const aName: string; Kind: char): TFDMarker;
|
|
procedure CheckReferenceMarkers;
|
|
procedure FindDeclarations(Filename: string; ExpandFile: boolean = true);
|
|
procedure FindDeclarations(aCode: TCodeBuffer);
|
|
procedure TestFiles(Directory: string);
|
|
property MainCode: TCodeBuffer read FMainCode;
|
|
property MainTool: TCodeTool read FMainTool;
|
|
end;
|
|
|
|
{ TTestFindDeclaration }
|
|
|
|
TTestFindDeclaration = class(TCustomTestFindDeclaration)
|
|
published
|
|
procedure TestFindDeclaration_Program;
|
|
procedure TestFindDeclaration_Basic;
|
|
procedure TestFindDeclaration_Proc_BaseTypes;
|
|
procedure TestFindDeclaration_With;
|
|
procedure TestFindDeclaration_ClassOf;
|
|
procedure TestFindDeclaration_NestedClasses;
|
|
procedure TestFindDeclaration_ClassHelper;
|
|
procedure TestFindDeclaration_TypeHelper;
|
|
procedure TestFindDeclaration_ObjCClass;
|
|
procedure TestFindDeclaration_ObjCCategory;
|
|
procedure TestFindDeclaration_GenericFunction;
|
|
procedure TestFindDeclaration_Generics_Enumerator;
|
|
procedure TestFindDeclaration_Generics;
|
|
procedure TestFindDeclaration_GenericsDelphi_InterfaceAncestor;
|
|
procedure TestFindDeclaration_ForIn;
|
|
procedure TestFindDeclaration_FileAtCursor;
|
|
procedure TestFindDeclaration_CBlocks;
|
|
procedure TestFindDeclaration_Arrays;
|
|
procedure TestFindDeclaration_GuessType;
|
|
procedure TestFindDeclaration_Attributes;
|
|
// test all files in directories:
|
|
procedure TestFindDeclaration_FPCTests;
|
|
procedure TestFindDeclaration_LazTests;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ TCustomTestFindDeclaration }
|
|
|
|
procedure TCustomTestFindDeclaration.CheckReferenceMarkers;
|
|
var
|
|
i, FoundTopLine, FoundCleanPos, BlockTopLine, BlockBottomLine: Integer;
|
|
Marker, DeclMarker: TFDMarker;
|
|
CursorPos, FoundCursorPos: TCodeXYPosition;
|
|
FoundTool: TFindDeclarationTool;
|
|
begin
|
|
for i:=0 to MarkerCount-1 do begin
|
|
Marker:=Markers[i];
|
|
if Marker.Kind=MarkRef then begin
|
|
DeclMarker:=FindMarker(Marker.Name,MarkDecl);
|
|
if DeclMarker=nil then
|
|
Fail('ref has no decl marker. ref "'+Marker.Name+'" at '+MainTool.CleanPosToStr(Marker.CleanPos));
|
|
MainTool.CleanPosToCaret(Marker.NameStartPos,CursorPos);
|
|
|
|
// test FindDeclaration
|
|
if not CodeToolBoss.FindDeclaration(CursorPos.Code,CursorPos.X,CursorPos.Y,
|
|
FoundCursorPos.Code,FoundCursorPos.X,FoundCursorPos.Y,FoundTopLine,
|
|
BlockTopLine,BlockBottomLine)
|
|
then begin
|
|
WriteSource(CursorPos);
|
|
Fail('find declaration failed at '+MainTool.CleanPosToStr(Marker.NameStartPos,true)+': '+CodeToolBoss.ErrorMessage);
|
|
end else begin
|
|
FoundTool:=CodeToolBoss.GetCodeToolForSource(FoundCursorPos.Code,true,true) as TFindDeclarationTool;
|
|
if FoundTool<>MainTool then begin
|
|
WriteSource(CursorPos);
|
|
Fail('find declaration at '+MainTool.CleanPosToStr(Marker.NameStartPos,true)
|
|
+' returned wrong tool "'+FoundTool.MainFilename+'" instead of "'+MainTool.MainFilename+'"');
|
|
end;
|
|
MainTool.CaretToCleanPos(FoundCursorPos,FoundCleanPos);
|
|
if (FoundCleanPos<DeclMarker.NameStartPos)
|
|
or (FoundCleanPos>DeclMarker.NameEndPos) then begin
|
|
WriteSource(CursorPos);
|
|
Fail('find declaration at '+MainTool.CleanPosToStr(Marker.NameStartPos,true)
|
|
+' returned wrong position "'+MainTool.CleanPosToStr(FoundCleanPos)+'"'
|
|
+' instead of "'+MainTool.CleanPosToStr(Marker.NameStartPos)+'"');
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTestFindDeclaration.FindDeclarations(Filename: string;
|
|
ExpandFile: boolean);
|
|
var
|
|
aCode: TCodeBuffer;
|
|
begin
|
|
if ExpandFile then
|
|
Filename:=TrimAndExpandFilename(Filename);
|
|
{$IFDEF VerboseFindDeclarationTests}
|
|
debugln(['TTestFindDeclaration.FindDeclarations File=',Filename]);
|
|
{$ENDIF}
|
|
aCode:=CodeToolBoss.LoadFile(Filename,true,false);
|
|
if aCode=nil then
|
|
raise Exception.Create('unable to load '+Filename);
|
|
FindDeclarations(aCode);
|
|
end;
|
|
|
|
procedure TCustomTestFindDeclaration.FindDeclarations(aCode: TCodeBuffer);
|
|
|
|
procedure PrependPath(Prefix: string; var Path: string);
|
|
begin
|
|
if Path<>'' then Path:='.'+Path;
|
|
Path:=Prefix+Path;
|
|
end;
|
|
|
|
function NodeAsPath(Tool: TFindDeclarationTool; Node: TCodeTreeNode): string;
|
|
begin
|
|
Result:='';
|
|
while Node<>nil do begin
|
|
case Node.Desc of
|
|
ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition,ctnGenericParameter:
|
|
PrependPath(GetIdentifier(@Tool.Src[Node.StartPos]),Result);
|
|
ctnGenericType:
|
|
PrependPath(GetIdentifier(@Tool.Src[Node.FirstChild.StartPos]),Result);
|
|
ctnInterface,ctnUnit:
|
|
PrependPath(Tool.GetSourceName(false),Result);
|
|
ctnProcedure:
|
|
PrependPath(Tool.ExtractProcName(Node,[]),Result);
|
|
ctnProperty:
|
|
PrependPath(Tool.ExtractPropName(Node,false),Result);
|
|
ctnUseUnit:
|
|
PrependPath(Tool.ExtractUsedUnitName(Node),Result);
|
|
ctnUseUnitNamespace,ctnUseUnitClearName:
|
|
begin
|
|
PrependPath(GetIdentifier(@Tool.Src[Node.StartPos]),Result);
|
|
if Node.PriorBrother<>nil then begin
|
|
Node:=Node.PriorBrother;
|
|
continue;
|
|
end else
|
|
Node:=Node.Parent;
|
|
end;
|
|
//else debugln(['NodeAsPath ',Node.DescAsString]);
|
|
end;
|
|
Node:=Node.Parent;
|
|
end;
|
|
//debugln(['NodeAsPath ',Result]);
|
|
end;
|
|
|
|
var
|
|
CommentP: Integer;
|
|
p: Integer;
|
|
ExpectedPath: String;
|
|
PathPos: Integer;
|
|
CursorPos, FoundCursorPos: TCodeXYPosition;
|
|
FoundTopLine: integer;
|
|
FoundTool: TFindDeclarationTool;
|
|
FoundCleanPos: Integer;
|
|
FoundNode: TCodeTreeNode;
|
|
FoundPath: String;
|
|
Src: String;
|
|
NameStartPos, i, l, IdentifierStartPos, IdentifierEndPos,
|
|
BlockTopLine, BlockBottomLine: Integer;
|
|
Marker, ExpectedType, NewType: String;
|
|
IdentItem: TIdentifierListItem;
|
|
ItsAKeyword, IsSubIdentifier: boolean;
|
|
ExistingDefinition: TFindContext;
|
|
ListOfPFindContext: TFPList;
|
|
NewExprType: TExpressionType;
|
|
begin
|
|
FMainCode:=aCode;
|
|
DoParseModule(MainCode,FMainTool);
|
|
CommentP:=1;
|
|
Src:=MainTool.Src;
|
|
while CommentP<length(Src) do begin
|
|
CommentP:=FindNextComment(Src,CommentP);
|
|
if CommentP>length(Src) then break;
|
|
p:=CommentP;
|
|
CommentP:=FindCommentEnd(Src,CommentP,MainTool.Scanner.NestedComments);
|
|
if Src[p]<>'{' then continue;
|
|
if Src[p+1] in ['$','%',' ',#0..#31] then continue;
|
|
|
|
IdentifierStartPos:=p;
|
|
IdentifierEndPos:=p;
|
|
while (IdentifierStartPos>1) and (IsIdentChar[Src[IdentifierStartPos-1]]) do
|
|
dec(IdentifierStartPos);
|
|
if IdentifierStartPos=p then begin
|
|
WriteSource(p,MainTool);
|
|
Fail('missing identifier in front of marker at '+MainTool.CleanPosToStr(p));
|
|
end;
|
|
inc(p);
|
|
NameStartPos:=p;
|
|
if Src[p] in ['#','@'] then begin
|
|
{#name} {@name}
|
|
inc(p);
|
|
if not IsIdentStartChar[Src[p]] then begin
|
|
WriteSource(p,MainTool);
|
|
Fail('Expected identifier at '+MainTool.CleanPosToStr(p,true));
|
|
end;
|
|
NameStartPos:=p;
|
|
while IsIdentChar[Src[p]] do inc(p);
|
|
Marker:=copy(Src,NameStartPos,p-NameStartPos);
|
|
AddMarker(Marker,Src[NameStartPos],CommentP,IdentifierStartPos,IdentifierEndPos);
|
|
continue;
|
|
end;
|
|
|
|
// check for specials:
|
|
{declaration:path}
|
|
{guesstype:type}
|
|
if not IsIdentStartChar[Src[p]] then continue;
|
|
while (p<=length(Src)) and (IsIdentChar[Src[p]]) do inc(p);
|
|
Marker:=copy(Src,NameStartPos,p-NameStartPos);
|
|
if (p>length(Src)) or (Src[p]<>':') then begin
|
|
WriteSource(p,MainTool);
|
|
AssertEquals('Expected : at '+MainTool.CleanPosToStr(p,true),'declaration',Marker);
|
|
continue;
|
|
end;
|
|
inc(p);
|
|
PathPos:=p;
|
|
|
|
//debugln(['TTestFindDeclaration.FindDeclarations Marker="',Marker,'" params: ',dbgstr(MainTool.Src,p,CommentP-p)]);
|
|
if (Marker='declaration') then begin
|
|
ExpectedPath:=copy(Src,PathPos,CommentP-1-PathPos);
|
|
{$IFDEF VerboseFindDeclarationTests}
|
|
debugln(['TTestFindDeclaration.FindDeclarations searching "',Marker,'" at ',MainTool.CleanPosToStr(NameStartPos-1),' ExpectedPath=',ExpectedPath]);
|
|
{$ENDIF}
|
|
MainTool.CleanPosToCaret(IdentifierStartPos,CursorPos);
|
|
|
|
// test FindDeclaration
|
|
if not CodeToolBoss.FindDeclaration(CursorPos.Code,CursorPos.X,CursorPos.Y,
|
|
FoundCursorPos.Code,FoundCursorPos.X,FoundCursorPos.Y,FoundTopLine,
|
|
BlockTopLine,BlockBottomLine)
|
|
then begin
|
|
if ExpectedPath<>'' then begin
|
|
//if (CodeToolBoss.ErrorCode<>nil) then begin
|
|
//ErrorTool:=CodeToolBoss.GetCodeToolForSource(CodeToolBoss.ErrorCode);
|
|
//if ErrorTool<>MainTool then
|
|
// WriteSource(,ErrorTool);
|
|
WriteSource(IdentifierStartPos,MainTool);
|
|
Fail('find declaration failed at '+MainTool.CleanPosToStr(IdentifierStartPos,true)+': '+CodeToolBoss.ErrorMessage);
|
|
end;
|
|
continue;
|
|
end else begin
|
|
FoundTool:=CodeToolBoss.GetCodeToolForSource(FoundCursorPos.Code,true,true) as TFindDeclarationTool;
|
|
FoundPath:='';
|
|
FoundNode:=nil;
|
|
if (FoundCursorPos.Y=1) and (FoundCursorPos.X=1) then begin
|
|
// unit
|
|
FoundPath:=ExtractFileNameOnly(FoundCursorPos.Code.Filename);
|
|
end else begin
|
|
FoundTool.CaretToCleanPos(FoundCursorPos,FoundCleanPos);
|
|
if (FoundCleanPos>1) and (IsIdentChar[FoundTool.Src[FoundCleanPos-1]]) then
|
|
dec(FoundCleanPos);
|
|
FoundNode:=FoundTool.FindDeepestNodeAtPos(FoundCleanPos,true);
|
|
//debugln(['TTestFindDeclaration.FindDeclarations Found: ',FoundTool.CleanPosToStr(FoundNode.StartPos,true),' FoundNode=',FoundNode.DescAsString]);
|
|
FoundPath:=NodeAsPath(FoundTool,FoundNode);
|
|
end;
|
|
//debugln(['TTestFindDeclaration.FindDeclarations FoundPath=',FoundPath]);
|
|
if LowerCase(ExpectedPath)<>LowerCase(FoundPath) then begin
|
|
WriteSource(IdentifierStartPos,MainTool);
|
|
AssertEquals('find declaration wrong at '+MainTool.CleanPosToStr(IdentifierStartPos,true),LowerCase(ExpectedPath),LowerCase(FoundPath));
|
|
end;
|
|
end;
|
|
|
|
// test identifier completion
|
|
if (ExpectedPath<>'') then begin
|
|
if not CodeToolBoss.GatherIdentifiers(CursorPos.Code,CursorPos.X,CursorPos.Y)
|
|
then begin
|
|
if ExpectedPath<>'' then begin
|
|
WriteSource(IdentifierStartPos,MainTool);
|
|
AssertEquals('GatherIdentifiers failed at '+MainTool.CleanPosToStr(IdentifierStartPos,true)+': '+CodeToolBoss.ErrorMessage,false,true);
|
|
end;
|
|
continue;
|
|
end else begin
|
|
i:=CodeToolBoss.IdentifierList.GetFilteredCount-1;
|
|
while i>=0 do begin
|
|
IdentItem:=CodeToolBoss.IdentifierList.FilteredItems[i];
|
|
//debugln(['TTestFindDeclaration.FindDeclarations ',IdentItem.Identifier]);
|
|
l:=length(IdentItem.Identifier);
|
|
if ((l=length(ExpectedPath)) or (ExpectedPath[length(ExpectedPath)-l]='.'))
|
|
and (CompareText(IdentItem.Identifier,RightStr(ExpectedPath,l))=0)
|
|
then break;
|
|
dec(i);
|
|
end;
|
|
if i<0 then begin
|
|
WriteSource(IdentifierStartPos,MainTool);
|
|
AssertEquals('GatherIdentifiers misses "'+ExpectedPath+'" at '+MainTool.CleanPosToStr(IdentifierStartPos,true),true,i>=0);
|
|
end;
|
|
end;
|
|
end;
|
|
end else if Marker='guesstype' then begin
|
|
ExpectedType:=copy(Src,PathPos,CommentP-1-PathPos);
|
|
{$IFDEF VerboseFindDeclarationTests}
|
|
debugln(['TTestFindDeclaration.FindDeclarations "',Marker,'" at ',Tool.CleanPosToStr(NameStartPos-1),' ExpectedType=',ExpectedType]);
|
|
{$ENDIF}
|
|
MainTool.CleanPosToCaret(IdentifierStartPos,CursorPos);
|
|
|
|
// test GuessTypeOfIdentifier
|
|
ListOfPFindContext:=nil;
|
|
try
|
|
if not CodeToolBoss.GuessTypeOfIdentifier(CursorPos.Code,CursorPos.X,CursorPos.Y,
|
|
ItsAKeyword, IsSubIdentifier, ExistingDefinition, ListOfPFindContext,
|
|
NewExprType, NewType)
|
|
then begin
|
|
if ExpectedType<>'' then
|
|
AssertEquals('GuessTypeOfIdentifier failed at '+MainTool.CleanPosToStr(IdentifierStartPos,true)+': '+CodeToolBoss.ErrorMessage,false,true);
|
|
continue;
|
|
end else begin
|
|
//debugln(['TTestFindDeclaration.FindDeclarations FoundPath=',FoundPath]);
|
|
if LowerCase(ExpectedType)<>LowerCase(NewType) then begin
|
|
WriteSource(IdentifierStartPos,MainTool);
|
|
AssertEquals('GuessTypeOfIdentifier wrong at '+MainTool.CleanPosToStr(IdentifierStartPos,true),LowerCase(ExpectedType),LowerCase(NewType));
|
|
end;
|
|
end;
|
|
finally
|
|
FreeListOfPFindContext(ListOfPFindContext);
|
|
end;
|
|
|
|
end else begin
|
|
WriteSource(IdentifierStartPos,MainTool);
|
|
AssertEquals('Unknown marker at '+MainTool.CleanPosToStr(IdentifierStartPos,true),'declaration',Marker);
|
|
continue;
|
|
end;
|
|
end;
|
|
CheckReferenceMarkers;
|
|
end;
|
|
|
|
function TCustomTestFindDeclaration.GetMarkers(Index: integer): TFDMarker;
|
|
begin
|
|
Result:=TFDMarker(FMarkers[Index]);
|
|
end;
|
|
|
|
procedure TCustomTestFindDeclaration.TestFiles(Directory: string);
|
|
const
|
|
fmparam = '--filemask=';
|
|
var
|
|
Info: TSearchRec;
|
|
aFilename, Param, aFileMask: String;
|
|
i: Integer;
|
|
Verbose: Boolean;
|
|
begin
|
|
aFileMask:='t*.p*';
|
|
Verbose:=false;
|
|
for i:=1 to ParamCount do begin
|
|
Param:=ParamStr(i);
|
|
if LeftStr(Param,length(fmparam))=fmparam then
|
|
aFileMask:=copy(Param,length(fmparam)+1,100);
|
|
if Param='-v' then
|
|
Verbose:=true;
|
|
end;
|
|
Directory:=AppendPathDelim(Directory);
|
|
|
|
if FindFirstUTF8(Directory+aFileMask,faAnyFile,Info)=0 then begin
|
|
repeat
|
|
if faDirectory and Info.Attr>0 then continue;
|
|
aFilename:=Info.Name;
|
|
if not FilenameIsPascalUnit(aFilename) then continue;
|
|
if Verbose then
|
|
debugln(['TTestFindDeclaration.TestFiles File="',aFilename,'"']);
|
|
FindDeclarations(Directory+aFilename);
|
|
until FindNextUTF8(Info)<>0;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomTestFindDeclaration.SetUp;
|
|
begin
|
|
inherited SetUp;
|
|
FMarkers:=TObjectList.Create(true);
|
|
end;
|
|
|
|
procedure TCustomTestFindDeclaration.TearDown;
|
|
begin
|
|
FMainCode:=nil;
|
|
FMainTool:=nil;
|
|
FreeAndNil(FMarkers);
|
|
inherited TearDown;
|
|
end;
|
|
|
|
function TCustomTestFindDeclaration.MarkerCount: integer;
|
|
begin
|
|
if FMarkers=nil then
|
|
Result:=0
|
|
else
|
|
Result:=FMarkers.Count;
|
|
end;
|
|
|
|
function TCustomTestFindDeclaration.AddMarker(const aName: string; Kind: char;
|
|
CleanPos: integer; NameStartPos, NameEndPos: integer): TFDMarker;
|
|
begin
|
|
if (Kind=MarkDecl) then begin
|
|
Result:=FindMarker(aName,Kind);
|
|
if Result<>nil then
|
|
Fail('duplicate decl marker at '+MainTool.CleanPosToStr(CleanPos)+' and at '+MainTool.CleanPosToStr(Result.CleanPos));
|
|
end;
|
|
Result:=TFDMarker.Create;
|
|
Result.Name:=aName;
|
|
Result.Kind:=Kind;
|
|
Result.CleanPos:=CleanPos;
|
|
Result.NameStartPos:=NameStartPos;
|
|
Result.NameEndPos:=NameEndPos;
|
|
FMarkers.Add(Result);
|
|
end;
|
|
|
|
function TCustomTestFindDeclaration.IndexOfMarker(const aName: string; Kind: char
|
|
): integer;
|
|
var
|
|
i: Integer;
|
|
Marker: TFDMarker;
|
|
begin
|
|
for i:=0 to MarkerCount-1 do begin
|
|
Marker:=Markers[i];
|
|
if (Marker.Kind=Kind) and (CompareText(Markers[i].Name,aName)=0) then
|
|
exit(i);
|
|
end;
|
|
Result:=-1;
|
|
end;
|
|
|
|
procedure TCustomTestFindDeclaration.ParseSimpleMarkers(aCode: TCodeBuffer);
|
|
var
|
|
CommentP, p, IdentifierStartPos, IdentifierEndPos, NameStartPos: Integer;
|
|
Src, Marker: String;
|
|
begin
|
|
FMainCode:=aCode;
|
|
DoParseModule(MainCode,FMainTool);
|
|
CommentP:=1;
|
|
Src:=MainTool.Src;
|
|
while CommentP<length(Src) do begin
|
|
CommentP:=FindNextComment(Src,CommentP);
|
|
if CommentP>length(Src) then break;
|
|
p:=CommentP;
|
|
CommentP:=FindCommentEnd(Src,CommentP,MainTool.Scanner.NestedComments);
|
|
if Src[p]<>'{' then continue;
|
|
if Src[p+1] in ['$','%',' ',#0..#31] then continue;
|
|
|
|
IdentifierStartPos:=p;
|
|
IdentifierEndPos:=p;
|
|
while (IdentifierStartPos>1) and (IsIdentChar[Src[IdentifierStartPos-1]]) do
|
|
dec(IdentifierStartPos);
|
|
|
|
inc(p);
|
|
NameStartPos:=p;
|
|
if Src[p] in ['#','@'] then begin
|
|
{#name} {@name}
|
|
inc(p);
|
|
if not IsIdentStartChar[Src[p]] then begin
|
|
WriteSource(p,MainTool);
|
|
Fail('Expected identifier at '+MainTool.CleanPosToStr(p,true));
|
|
end;
|
|
NameStartPos:=p;
|
|
while IsIdentChar[Src[p]] do inc(p);
|
|
Marker:=copy(Src,NameStartPos,p-NameStartPos);
|
|
AddMarker(Marker,Src[NameStartPos-1],CommentP,IdentifierStartPos,IdentifierEndPos);
|
|
end else begin
|
|
WriteSource(p,MainTool);
|
|
Fail('invalid marker at '+MainTool.CleanPosToStr(p));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCustomTestFindDeclaration.FindMarker(const aName: string; Kind: char
|
|
): TFDMarker;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i:=IndexOfMarker(aName,Kind);
|
|
if i<0 then
|
|
Result:=nil
|
|
else
|
|
Result:=Markers[i];
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_Program;
|
|
begin
|
|
StartProgram;
|
|
Add([
|
|
'var Cow: longint;',
|
|
'begin',
|
|
' cow{declaration:Cow}:=3;',
|
|
' test1{declaration:Test1}.cow{declaration:Cow}:=3;',
|
|
'end.',
|
|
'']);
|
|
FindDeclarations(Code);
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_Basic;
|
|
begin
|
|
FindDeclarations('moduletests/fdt_basic.pas');
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_Proc_BaseTypes;
|
|
begin
|
|
FindDeclarations('moduletests/fdt_proc_basetypes.pas');
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_With;
|
|
begin
|
|
FindDeclarations('moduletests/fdt_with.pas');
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_ClassOf;
|
|
begin
|
|
FindDeclarations('moduletests/fdt_classof.pas');
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_NestedClasses;
|
|
begin
|
|
FindDeclarations('moduletests/fdt_nestedclasses.pas');
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_ClassHelper;
|
|
begin
|
|
FindDeclarations('moduletests/fdt_classhelper.pas');
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_TypeHelper;
|
|
begin
|
|
FindDeclarations('moduletests/fdt_typehelper.pas');
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_ObjCClass;
|
|
begin
|
|
{$IFDEF Darwin}
|
|
FindDeclarations('moduletests/fdt_objcclass.pas');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_ObjCCategory;
|
|
begin
|
|
{$IFDEF Darwin}
|
|
FindDeclarations('moduletests/fdt_objccategory.pas');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_GenericFunction;
|
|
begin
|
|
StartProgram;
|
|
Add([
|
|
'{$mode objfpc}',
|
|
'generic function RandomFrom<T>(const AValues:array of T):T;',
|
|
'begin',
|
|
' Result:=Avalue[1];',
|
|
'end;',
|
|
'begin',
|
|
' i:=RandomFrom<longint>([1,2,3]);',
|
|
'end.',
|
|
'']);
|
|
FindDeclarations(Code);
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_Generics_Enumerator;
|
|
begin
|
|
StartProgram;
|
|
Add([
|
|
'type',
|
|
' integer = longint;',
|
|
' TOwnedCollection = class',
|
|
' end;',
|
|
' generic TMyOwnedCollection<T: class> = class(TOwnedCollection)',
|
|
' public type',
|
|
' TEnumerator = class',
|
|
' private',
|
|
' FIndex: Integer;',
|
|
' FCol: specialize TMyOwnedCollection<T>;',
|
|
' public',
|
|
' constructor Create(ACol: specialize TMyOwnedCollection<T>);',
|
|
' function GetCurrent: T;',
|
|
' function MoveNext: Boolean;',
|
|
' property Current: T read GetCurrent;',
|
|
' end;',
|
|
' public',
|
|
' function GetEnumerator: TEnumerator;',
|
|
' function GetItem(AIndex: Integer): T;',
|
|
' end;',
|
|
'end.']);
|
|
FindDeclarations(Code);
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_Generics;
|
|
begin
|
|
FindDeclarations('moduletests/fdt_generics.pas');
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_GenericsDelphi_InterfaceAncestor;
|
|
begin
|
|
StartProgram;
|
|
Add([
|
|
'{$mode delphi}',
|
|
'type',
|
|
' IParameters = interface',
|
|
' end;',
|
|
' IItem = class',
|
|
' end;',
|
|
' IBirdy = interface (IParameters<IItem>)',
|
|
' [''guid'']',
|
|
' end;',
|
|
'end.']);
|
|
FindDeclarations(Code);
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_ForIn;
|
|
begin
|
|
FindDeclarations('moduletests/fdt_for_in.pas');
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_FileAtCursor;
|
|
var
|
|
SubUnit2Code, LFMCode: TCodeBuffer;
|
|
Found: TFindFileAtCursorFlag;
|
|
FoundFilename: string;
|
|
begin
|
|
FMainCode:=CodeToolBoss.CreateFile('test1.lpr');
|
|
MainCode.Source:='uses unit2 in ''sub/../unit2.pas'';'+LineEnding;
|
|
SubUnit2Code:=CodeToolBoss.CreateFile('unit2.pas');
|
|
LFMCode:=CodeToolBoss.CreateFile('test1.lfm');
|
|
try
|
|
// --- used unit ---
|
|
// test cursor on 'unit2'
|
|
if not CodeToolBoss.FindFileAtCursor(MainCode,6,1,Found,FoundFilename) then
|
|
Fail('CodeToolBoss.FindFileAtCursor at uses unit2');
|
|
AssertEquals('FindFileAtCursor at uses unit2 Found',ord(ffatUsedUnit),ord(Found));
|
|
AssertEquals('FindFileAtCursor at uses unit2 FoundFilename','unit2.pas',FoundFilename);
|
|
// test cursor on 'in'
|
|
if not CodeToolBoss.FindFileAtCursor(MainCode,12,1,Found,FoundFilename) then
|
|
Fail('CodeToolBoss.FindFileAtCursor at uses unit2-in');
|
|
AssertEquals('FindFileAtCursor at uses unit2-in Found',ord(ffatUsedUnit),ord(Found));
|
|
AssertEquals('FindFileAtCursor at uses unit2-in FoundFilename','unit2.pas',FoundFilename);
|
|
// test cursor on in-file literal
|
|
if not CodeToolBoss.FindFileAtCursor(MainCode,16,1,Found,FoundFilename) then
|
|
Fail('CodeToolBoss.FindFileAtCursor at uses unit2-in-literal');
|
|
AssertEquals('FindFileAtCursor at uses unit2-in-lit Found',ord(ffatUsedUnit),ord(Found));
|
|
AssertEquals('FindFileAtCursor at uses unit2-in-lit FoundFilename','unit2.pas',FoundFilename);
|
|
|
|
// --- enabled include directive ---
|
|
// test cursor on enabled include directive of empty file
|
|
MainCode.Source:='program test1;'+LineEnding
|
|
+'{$i unit2.pas}'+LineEnding;
|
|
SubUnit2Code.Source:='';
|
|
if not CodeToolBoss.FindFileAtCursor(MainCode,1,2,Found,FoundFilename) then
|
|
Fail('CodeToolBoss.FindFileAtCursor at enabled include directive of empty inc');
|
|
AssertEquals('FindFileAtCursor at enabled include directive of empty Found',ord(ffatIncludeFile),ord(Found));
|
|
AssertEquals('FindFileAtCursor at enabled include directive of empty FoundFilename','unit2.pas',FoundFilename);
|
|
|
|
// test cursor on enabled include directive of not empty file
|
|
SubUnit2Code.Source:='{$define a}';
|
|
if not CodeToolBoss.FindFileAtCursor(MainCode,1,2,Found,FoundFilename) then
|
|
Fail('CodeToolBoss.FindFileAtCursor at enabled include directive of non-empty inc');
|
|
AssertEquals('FindFileAtCursor at enabled include directive of non-empty Found',ord(ffatIncludeFile),ord(Found));
|
|
AssertEquals('FindFileAtCursor at enabled include directive of non-empty FoundFilename','unit2.pas',FoundFilename);
|
|
|
|
// --- disabled include directive ---
|
|
// test cursor on disabled include directive
|
|
MainCode.Source:='program test1;'+LineEnding
|
|
+'{$ifdef disabled}'+LineEnding
|
|
+'{$i unit2.pas}'+LineEnding
|
|
+'{$endif}'+LineEnding;
|
|
SubUnit2Code.Source:='';
|
|
if not CodeToolBoss.FindFileAtCursor(MainCode,1,3,Found,FoundFilename) then
|
|
Fail('CodeToolBoss.FindFileAtCursor at disabled include directive');
|
|
AssertEquals('FindFileAtCursor at disabled include directive Found',ord(ffatDisabledIncludeFile),ord(Found));
|
|
AssertEquals('FindFileAtCursor at disabled include directive FoundFilename','unit2.pas',FoundFilename);
|
|
|
|
// --- enabled resource directive ---
|
|
MainCode.Source:='program test1;'+LineEnding
|
|
+'{$R test1.lfm}'+LineEnding;
|
|
if not CodeToolBoss.FindFileAtCursor(MainCode,1,2,Found,FoundFilename) then
|
|
Fail('CodeToolBoss.FindFileAtCursor at enabled resource directive');
|
|
AssertEquals('FindFileAtCursor at enabled resource directive Found',ord(ffatResource),ord(Found));
|
|
AssertEquals('FindFileAtCursor at enabled resource directive FoundFilename','test1.lfm',FoundFilename);
|
|
|
|
MainCode.Source:='program test1;'+LineEnding
|
|
+'{$R *.lfm}'+LineEnding;
|
|
if not CodeToolBoss.FindFileAtCursor(MainCode,1,2,Found,FoundFilename) then
|
|
Fail('CodeToolBoss.FindFileAtCursor at enabled resource directive');
|
|
AssertEquals('FindFileAtCursor at enabled resource directive Found',ord(ffatResource),ord(Found));
|
|
AssertEquals('FindFileAtCursor at enabled resource directive FoundFilename','test1.lfm',FoundFilename);
|
|
|
|
// --- disabled resource directive ---
|
|
MainCode.Source:='program test1;'+LineEnding
|
|
+'{$ifdef disabled}'+LineEnding
|
|
+'{$R test1.lfm}'+LineEnding
|
|
+'{$endif}'+LineEnding;
|
|
if not CodeToolBoss.FindFileAtCursor(MainCode,1,3,Found,FoundFilename) then
|
|
Fail('CodeToolBoss.FindFileAtCursor at disabled resource directive');
|
|
AssertEquals('FindFileAtCursor at disabled resource directive Found',ord(ffatDisabledResource),ord(Found));
|
|
AssertEquals('FindFileAtCursor at disabled resource directive FoundFilename','test1.lfm',FoundFilename);
|
|
|
|
// --- literal ---
|
|
MainCode.Source:='program test1;'+LineEnding
|
|
+'const Cfg=''unit2.pas'';'+LineEnding;
|
|
if not CodeToolBoss.FindFileAtCursor(MainCode,11,2,Found,FoundFilename) then
|
|
Fail('CodeToolBoss.FindFileAtCursor in literal');
|
|
AssertEquals('FindFileAtCursor in literal Found',ord(ffatLiteral),ord(Found));
|
|
AssertEquals('FindFileAtCursor in literal FoundFilename','unit2.pas',FoundFilename);
|
|
|
|
// --- comment ---
|
|
MainCode.Source:='program test1;'+LineEnding
|
|
+'{unit2.pas}'+LineEnding;
|
|
if not CodeToolBoss.FindFileAtCursor(MainCode,3,2,Found,FoundFilename) then
|
|
Fail('CodeToolBoss.FindFileAtCursor in comment');
|
|
AssertEquals('FindFileAtCursor in comment Found',ord(ffatComment),ord(Found));
|
|
AssertEquals('FindFileAtCursor in comment FoundFilename','unit2.pas',FoundFilename);
|
|
|
|
// --- unit name search in comment ---
|
|
MainCode.Source:='program test1;'+LineEnding
|
|
+'{unit2}'+LineEnding;
|
|
if not CodeToolBoss.FindFileAtCursor(MainCode,3,2,Found,FoundFilename) then
|
|
Fail('CodeToolBoss.FindFileAtCursor in comment');
|
|
AssertEquals('FindFileAtCursor in comment Found',ord(ffatUnit),ord(Found));
|
|
AssertEquals('FindFileAtCursor in comment FoundFilename','unit2.pas',FoundFilename);
|
|
|
|
// --- unit name search in MainCode ---
|
|
MainCode.Source:='program test1;'+LineEnding
|
|
+'begin'+LineEnding
|
|
+' unit2.Test;'+LineEnding;
|
|
if not CodeToolBoss.FindFileAtCursor(MainCode,3,3,Found,FoundFilename) then
|
|
Fail('CodeToolBoss.FindFileAtCursor in comment');
|
|
AssertEquals('FindFileAtCursor in comment Found',ord(ffatUnit),ord(Found));
|
|
AssertEquals('FindFileAtCursor in comment FoundFilename','unit2.pas',FoundFilename);
|
|
|
|
finally
|
|
MainCode.IsDeleted:=true;
|
|
SubUnit2Code.IsDeleted:=true;
|
|
LFMCode.IsDeleted:=true;
|
|
end;
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_CBlocks;
|
|
begin
|
|
StartProgram;
|
|
Add([
|
|
'{$modeswitch cblocks}',
|
|
'type tblock = reference to procedure; cdecl;',
|
|
'procedure test(b: tblock);',
|
|
'begin',
|
|
' b;',
|
|
'end;',
|
|
'procedure proc;',
|
|
'begin',
|
|
'end;',
|
|
'const bconst: tblock = @proc;',
|
|
'var',
|
|
' b: tblock;',
|
|
'begin',
|
|
' b:=@proc;',
|
|
' b;',
|
|
' test{declaration:test1.test}(@proc);',
|
|
' test{declaration:test1.test}(b);',
|
|
' bconst{declaration:test1.bconst};',
|
|
' test{declaration:test1.test}(bconst{declaration:test1.bconst});',
|
|
'end.',
|
|
'']);
|
|
ParseModule;
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_Arrays;
|
|
begin
|
|
FindDeclarations('moduletests/fdt_arrays.pas');
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_GuessType;
|
|
begin
|
|
FindDeclarations('moduletests/fdt_guesstype1.pas');
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_Attributes;
|
|
var
|
|
Node: TCodeTreeNode;
|
|
p: Integer;
|
|
Src: String;
|
|
begin
|
|
StartProgram;
|
|
Add([
|
|
'{$modeswitch prefixedattributes}',
|
|
'type',
|
|
' TCustomAttribute = class',
|
|
' end;',
|
|
' BirdAttribute = class(TCustomAttribute)',
|
|
' end;',
|
|
' Bird = class(TCustomAttribute)',
|
|
' end;',
|
|
' [Bird{declaration:BirdAttribute}]',
|
|
' THawk = class',
|
|
' [Bird{declaration:BirdAttribute}(1)]',
|
|
' FField: integer;',
|
|
' [Bird(2)]',
|
|
' procedure DoSome;',
|
|
' [Bird(3)]',
|
|
' property F: integer read FField;',
|
|
' end;',
|
|
' IMy = interface',
|
|
' [''guid'']',
|
|
' [Bird]',
|
|
' [Bird(12)]',
|
|
' function GetSome: integer;',
|
|
' [Bird(13)]',
|
|
' property Some: integer read GetSome;',
|
|
' end;',
|
|
' IMy = dispinterface',
|
|
' [''guid'']',
|
|
' [Bird(21)]',
|
|
' function GetMore: integer;',
|
|
' end;',
|
|
'[test1.bird]',
|
|
'[bird(4)]',
|
|
'procedure DoIt; forward;',
|
|
'[bird(5)]',
|
|
'procedure DoIt;',
|
|
'begin',
|
|
'end;',
|
|
'var',
|
|
' [bird(1+2,3),bird]',
|
|
' Foo: TObject;',
|
|
'begin',
|
|
'end.',
|
|
'']);
|
|
FindDeclarations(Code);
|
|
// check if all attributes were parsed
|
|
Src:=MainTool.Src;
|
|
for p:=1 to length(Src) do begin
|
|
if (Src[p]='[') and (IsIdentStartChar[Src[p+1]]) then begin
|
|
Node:=MainTool.FindDeepestNodeAtPos(p,false);
|
|
if (Node=nil) then begin
|
|
WriteSource(p,MainTool);
|
|
Fail('missing node at '+MainTool.CleanPosToStr(p));
|
|
end;
|
|
if (Node.Desc<>ctnAttribute) then begin
|
|
WriteSource(p,MainTool);
|
|
Fail('missing attribute at '+MainTool.CleanPosToStr(p));
|
|
end;
|
|
if Node.NextBrother=nil then begin
|
|
WriteSource(Node.StartPos,MainTool);
|
|
Fail('Attribute without NextBrother');
|
|
end;
|
|
if not (Node.NextBrother.Desc in [ctnAttribute,ctnVarDefinition,ctnTypeDefinition,ctnProcedure,ctnProperty])
|
|
then begin
|
|
WriteSource(Node.StartPos,MainTool);
|
|
Fail('Attribute invalid NextBrother '+Node.NextBrother.DescAsString);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_FPCTests;
|
|
begin
|
|
TestFiles('fpctests');
|
|
end;
|
|
|
|
procedure TTestFindDeclaration.TestFindDeclaration_LazTests;
|
|
begin
|
|
TestFiles('laztests');
|
|
end;
|
|
|
|
initialization
|
|
RegisterTests([TTestFindDeclaration]);
|
|
end.
|
|
|