paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-04 11:49:37 +01:00
Code Issues Packages Projects Releases Wiki Activity

codetools: tests for nested classes

Browse Source 
git-svn-id: trunk@48535 -
This commit is contained in:
mattias 2015-03-30 16:22:08 +00:00
parent 5fdf172812
commit e186e659ff
11 changed files with 229 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -963,6 +963,7 @@ components/codetools/resourcecodetool.pas svneol=native#text/pascal
components/codetools/sourcechanger.pas svneol=native#text/pascal
components/codetools/sourcelog.pas svneol=native#text/pascal
components/codetools/stdcodetools.pas svneol=native#text/pascal
components/codetools/tests/fdt_basic.pas svneol=native#text/plain
components/codetools/tests/fdt_classhelper.pas svneol=native#text/plain
components/codetools/tests/fdt_nestedclasses.pas svneol=native#text/plain
components/codetools/tests/fdtbase.pas svneol=native#text/plain
@ -971,6 +972,8 @@ components/codetools/tests/finddeclarationtest.lpr svneol=native#text/plain
components/codetools/tests/parsertbase.pas svneol=native#text/plain
components/codetools/tests/parsertest.lpi svneol=native#text/plain
components/codetools/tests/parsertest.lpr svneol=native#text/plain
components/codetools/tests/pt_thlp1.pas svneol=native#text/plain
components/codetools/tests/pt_thlp2.pas svneol=native#text/plain
components/codetools/unitdictionary.pas svneol=native#text/plain
components/compilers/c/examples/test.c svneol=native#text/plain
components/compilers/c/languages/lazcstrconsts.de.po svneol=native#text/plain

51
components/codetools/tests/fdt_basic.pas Normal file
View File

@ -0,0 +1,51 @@
unit fdt_basic;
{$mode objfpc}{$H+}
interface
uses
Classes{declaration:Classes}, SysUtils;
type
TMyClass2 = class;
{ TMyClass1 }
TMyClass1 = class
public
constructor Create{declaration:System.TObject.Create};
procedure DefaultHandler{declaration:System.TObject.DefaultHandler}(var message); override;
end;
{ TMyClass2 }
TMyClass2 = class(TMyClass1{declaration:fdt_basic.TMyClass1})
public
procedure DefaultHandler(var message); override;
end;
implementation
{ TMyClass1 }
constructor TMyClass1{declaration:fdt_basic.TMyClass1}.Create{declaration:fdt_basic.TMyClass1.Create};
begin
end;
procedure TMyClass1.DefaultHandler(var message);
begin
inherited DefaultHandler{declaration:System.TObject.DefaultHandler}(
message{declaration:TMyClass1.DefaultHandler.message});
end;
{ TMyClass2 }
procedure TMyClass2.DefaultHandler(var message);
begin
inherited DefaultHandler{declaration:fdt_basic.TMyClass1.DefaultHandler}(message);
end;
end.

2
components/codetools/tests/fdt_classhelper.pas
View File

@ -25,7 +25,7 @@ var
sl: TStringList;
begin
sl:=TStringList{declaration:Classes.TStringList}.Create;
writeln('DoIt ',sl.MyVar{declaration-classhelper:fdt_classhelper.TStringsClassHelper.MyVar});
writeln('DoIt ',sl.MyVar{declaration:fdt_classhelper.TStringsClassHelper.MyVar});
sl.Free;
end;

105
components/codetools/tests/fdtbase.pas
View File

@ -13,8 +13,8 @@ interface
uses
Classes, SysUtils, CodeToolManager, ExprEval, CodeCache, BasicCodeTools,
CustomCodeTool, CodeTree, FindDeclarationTool, LazLogger, LazFileUtils,
fpcunit, testregistry;
CustomCodeTool, CodeTree, FindDeclarationTool, KeywordFuncLists, LazLogger,
LazFileUtils, fpcunit, testregistry;
type
@ -22,7 +22,7 @@ type
TTestFindDeclaration = class(TTestCase)
private
procedure FindDeclarations(Filename, Marker: string);
procedure FindDeclarations(Filename: string);
published
procedure TestFindDeclaration_Base;
procedure TestFindDeclaration_NestedClasses;
@ -50,8 +50,7 @@ end;
{ TTestFindDeclaration }
procedure TTestFindDeclaration.FindDeclarations(Filename,
Marker: string);
procedure TTestFindDeclaration.FindDeclarations(Filename: string);
procedure PrependPath(Prefix: string; var Path: string);
begin
@ -62,8 +61,8 @@ procedure TTestFindDeclaration.FindDeclarations(Filename,
var
Code: TCodeBuffer;
Tool: TCodeTool;
CommentP: Integer;
p: Integer;
StartPos: Integer;
ExpectedPath: String;
PathPos: Integer;
CursorPos, FoundCursorPos: TCodeXYPosition;
@ -72,6 +71,9 @@ var
FoundCleanPos: Integer;
FoundNode: TCodeTreeNode;
FoundPath: String;
Src: String;
NameStartPos: Integer;
Marker: String;
begin
Filename:=TrimAndExpandFilename(Filename);
Code:=CodeToolBoss.LoadFile(Filename,true,false);
@ -81,58 +83,79 @@ begin
AssertEquals('parse error '+CodeToolBoss.ErrorMessage,false,true);
exit;
end;
p:=1;
while p<Tool.SrcLen do begin
p:=FindNextComment(Tool.Src,p);
if p>Tool.SrcLen then break;
StartPos:=p;
p:=FindCommentEnd(Tool.Src,p,Tool.Scanner.NestedComments);
if Tool.Src[StartPos]<>'{' then continue;
PathPos:=StartPos+1;
//debugln(['TTestFindDeclaration.FindDeclarations Comment: ',dbgstr(Tool.Src,StartPos,p-StartPos)]);
if copy(Tool.Src,PathPos,length(Marker))<>Marker then continue;
PathPos+=length(Marker);
ExpectedPath:=copy(Tool.Src,PathPos,p-1-PathPos);
//debugln(['TTestFindDeclaration.FindDeclarations ExpectedPath=',ExpectedPath]);
Tool.CleanPosToCaret(StartPos-1,CursorPos);
if not CodeToolBoss.FindDeclaration(CursorPos.Code,CursorPos.X,CursorPos.Y,
FoundCursorPos.Code,FoundCursorPos.X,FoundCursorPos.Y,FoundTopLine)
then begin
AssertEquals('find declaration failed at '+Tool.CleanPosToStr(StartPos-1)+': '+CodeToolBoss.ErrorMessage,false,true);
CommentP:=1;
Src:=Tool.Src;
while CommentP<length(Src) do begin
CommentP:=FindNextComment(Src,CommentP);
if CommentP>length(Src) then break;
p:=CommentP;
CommentP:=FindCommentEnd(Src,CommentP,Tool.Scanner.NestedComments);
if Src[p]<>'{' then continue;
inc(p);
NameStartPos:=p;
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
AssertEquals('Expected : at '+Tool.CleanPosToStr(p,true),'declaration',Marker);
continue;
end else begin
FoundTool:=CodeToolBoss.GetCodeToolForSource(FoundCursorPos.Code,true,true) as TFindDeclarationTool;
FoundTool.CaretToCleanPos(FoundCursorPos,FoundCleanPos);
FoundNode:=FoundTool.FindDeepestNodeAtPos(FoundCleanPos,true);
FoundPath:='';
while FoundNode<>nil do begin
case FoundNode.Desc of
ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition:
PrependPath(GetIdentifier(@FoundTool.Src[FoundNode.StartPos]),FoundPath);
ctnInterface,ctnUnit:
PrependPath(FoundTool.GetSourceName(false),FoundPath);
end;
inc(p);
PathPos:=p;
//debugln(['TTestFindDeclaration.FindDeclarations params: ',dbgstr(Tool.Src,p,CommentP-p)]);
if Marker='declaration' then begin
ExpectedPath:=copy(Src,PathPos,CommentP-1-PathPos);
//debugln(['TTestFindDeclaration.FindDeclarations ExpectedPath=',ExpectedPath]);
Tool.CleanPosToCaret(NameStartPos-1,CursorPos);
if not CodeToolBoss.FindDeclaration(CursorPos.Code,CursorPos.X,CursorPos.Y,
FoundCursorPos.Code,FoundCursorPos.X,FoundCursorPos.Y,FoundTopLine)
then begin
AssertEquals('find declaration failed at '+Tool.CleanPosToStr(NameStartPos-1)+': '+CodeToolBoss.ErrorMessage,false,true);
continue;
end else begin
FoundTool:=CodeToolBoss.GetCodeToolForSource(FoundCursorPos.Code,true,true) as TFindDeclarationTool;
FoundPath:='';
if (FoundCursorPos.Y=1) and (FoundCursorPos.X=1) then begin
// unit
FoundPath:=ExtractFileNameOnly(FoundCursorPos.Code.Filename);
end else begin
FoundTool.CaretToCleanPos(FoundCursorPos,FoundCleanPos);
FoundNode:=FoundTool.FindDeepestNodeAtPos(FoundCleanPos,true);
while FoundNode<>nil do begin
case FoundNode.Desc of
ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition:
PrependPath(GetIdentifier(@FoundTool.Src[FoundNode.StartPos]),FoundPath);
ctnInterface,ctnUnit:
PrependPath(FoundTool.GetSourceName(false),FoundPath);
ctnProcedureHead:
PrependPath(FoundTool.ExtractProcName(FoundNode,[]),FoundPath);
end;
FoundNode:=FoundNode.Parent;
end;
end;
FoundNode:=FoundNode.Parent;
//debugln(['TTestFindDeclaration.FindDeclarations FoundPath=',FoundPath]);
AssertEquals('find declaration wrong at '+Tool.CleanPosToStr(NameStartPos-1),LowerCase(ExpectedPath),LowerCase(FoundPath));
end;
//debugln(['TTestFindDeclaration.FindDeclarations FoundPath=',FoundPath]);
AssertEquals('find declaration wrong at '+Tool.CleanPosToStr(StartPos-1),LowerCase(ExpectedPath),LowerCase(FoundPath));
end else begin
AssertEquals('Unknown marker at '+Tool.CleanPosToStr(NameStartPos,true),'declaration',Marker);
continue;
end;
end;
end;
procedure TTestFindDeclaration.TestFindDeclaration_Base;
begin
FindDeclarations('fdt_classhelper.pas','declaration:');
FindDeclarations('fdt_basic.pas');
end;
procedure TTestFindDeclaration.TestFindDeclaration_NestedClasses;
begin
FindDeclarations('fdt_nestedclasses.pas','declaration:');
FindDeclarations('fdt_nestedclasses.pas');
end;
procedure TTestFindDeclaration.TestFindDeclaration_ClassHelper;
begin
FindDeclarations('fdt_classhelper.pas','declaration-classhelper:');
FindDeclarations('fdt_classhelper.pas');
end;
initialization

16
components/codetools/tests/finddeclarationtest.lpi
View File

@ -1,4 +1,4 @@
<?xml version="1.0"?>
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
@ -41,11 +41,10 @@
<PackageName Value="fpcunitconsolerunner"/>
</Item2>
</RequiredPackages>
<Units Count="4">
<Units Count="5">
<Unit0>
<Filename Value="finddeclarationtest.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="finddeclarationtest"/>
</Unit0>
<Unit1>
<Filename Value="fdtbase.pas"/>
@ -62,6 +61,11 @@
<IsPartOfProject Value="True"/>
<UnitName Value="fdt_nestedclasses"/>
</Unit3>
<Unit4>
<Filename Value="fdt_basic.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fdt_basic"/>
</Unit4>
</Units>
</ProjectOptions>
<CompilerOptions>
@ -73,12 +77,6 @@
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">

3
components/codetools/tests/finddeclarationtest.lpr
View File

@ -21,7 +21,8 @@ program finddeclarationtest;
uses
Classes, sysutils, consoletestrunner, dom, fpcunit, CodeToolManager,
CodeToolsConfig, LazLogger, fdtbase, fdt_classhelper, fdt_nestedclasses;
CodeToolsConfig, LazLogger, fdtbase, fdt_classhelper, fdt_nestedclasses,
fdt_basic;
const
ConfigFilename = 'codetools.config';

55
components/codetools/tests/parsertbase.pas
View File

@ -2,8 +2,9 @@
Test with:
./parsertest --format=plain --suite=TTestParseFPCTestUnits
./parsertest --format=plain --suite=TestParse_ugenconstraints
./parsertest --format=plain --suite=TestParse_PT_Files
}
unit parsertbase;
unit ParserTBase;
{$mode objfpc}{$H+}
@ -19,8 +20,10 @@ type
TTestParseFPCTestUnits = class(TTestCase)
private
procedure TestParseFile(aFilename: string);
published
procedure TestParse_ugenconstraints;
procedure TestParse_PT_Files;
end;
var
@ -44,6 +47,41 @@ end;
{ TTestParseFPCTestUnits }
procedure TTestParseFPCTestUnits.TestParseFile(aFilename: string);
var
Code: TCodeBuffer;
Tool: TCodeTool;
Src: String;
ShouldFail: Boolean;
FailPos: SizeInt;
begin
Code:=CodeToolBoss.LoadFile(aFilename,true,false);
if Code=nil then begin
AssertEquals('unable to read file "'+aFilename+'"',true,false);
exit;
end;
ShouldFail:=false;
Src:=Code.Source;
FailPos:=0;
if copy(Src,1,6)='{fail:' then begin
ShouldFail:=true;
FailPos:=Pos('{fail}',Src);
if FailPos>0 then FailPos+=6;
end;
if CodeToolBoss.Explore(Code,Tool,true) then begin
if ShouldFail then
AssertEquals('parser skipped error file "'+aFilename+'"',true,false);
end else begin
if ShouldFail then begin
if FailPos>0 then
AssertEquals('wrong parser pos in file "'+aFilename+'"',Tool.CleanPosToStr(FailPos),Tool.CodeXYToStr(Tool.ErrorPosition));
end else begin
AssertEquals('unable to parse file "'+aFilename+'"',true,false);
end;
end;
end;
procedure TTestParseFPCTestUnits.TestParse_ugenconstraints;
var
FPCDir: String;
@ -64,6 +102,21 @@ begin
end;
end;
procedure TTestParseFPCTestUnits.TestParse_PT_Files;
var
Info: TSearchRec;
Filename: TFilename;
Dir: String;
begin
Dir:=CleanAndExpandDirectory(GetCurrentDirUTF8);
if FindFirstUTF8(Dir+'pt_*.pas',faAnyFile,Info)=0 then begin
repeat
Filename:=Dir+Info.Name;
TestParseFile(Filename);
until FindNextUTF8(Info)<>0;
end;
end;
initialization
GetTestRegistry.TestName := 'All tests';
BugsTestSuite := TTestSuite.Create('Bugs');

18
components/codetools/tests/parsertest.lpi
View File

@ -1,4 +1,4 @@
<?xml version="1.0"?>
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
@ -41,17 +41,21 @@
<PackageName Value="fpcunitconsolerunner"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Units Count="3">
<Unit0>
<Filename Value="parsertest.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="parsertest"/>
</Unit0>
<Unit1>
<Filename Value="parsertbase.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="parsertbase"/>
<UnitName Value="ParserTBase"/>
</Unit1>
<Unit2>
<Filename Value="pt_thlp2.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="pt_thlp2"/>
</Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>
@ -63,12 +67,6 @@
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">

2
components/codetools/tests/parsertest.lpr
View File

@ -21,7 +21,7 @@ program parsertest;
uses
Classes, sysutils, consoletestrunner, dom, fpcunit,
CodeToolManager, CodeToolsConfig, parsertbase;
CodeToolManager, CodeToolsConfig, ParserTBase;
const
ConfigFilename = 'codetools.config';

19
components/codetools/tests/pt_thlp1.pas Normal file
View File

@ -0,0 +1,19 @@
{fail:type helper}
program pt_thlp1;
{$mode objfpc}{$H+}
{$modeswitch typehelpers-}
type
TTest = type helper {fail}for LongInt
procedure Test;
end;
procedure TTest.Test;
begin
end;
begin
end.

19
components/codetools/tests/pt_thlp2.pas Normal file
View File

@ -0,0 +1,19 @@
{type helper}
program pt_thlp2;
{$mode objfpc}{$H+}
{$modeswitch typehelpers}
type
TTest = type helper for LongInt
procedure Test;
end;
procedure TTest.Test;
begin
end;
begin
end.