1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
{
Test with:
./finddeclarationtest --format=plain --suite=TTestFindDeclarationClassHelper
./finddeclarationtest --format=plain --suite=TestFindDeclaration_Base
./finddeclarationtest --format=plain --suite=TestFindDeclaration_NestedClasses
./finddeclarationtest --format=plain --suite=TestFindDeclaration_ClassHelper
}
unit fdtbase;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, CodeToolManager, ExprEval, CodeCache, BasicCodeTools,
CustomCodeTool, CodeTree, FindDeclarationTool, LazLogger, LazFileUtils,
fpcunit, testregistry;
type
{ TTestFindDeclaration }
TTestFindDeclaration = class(TTestCase)
private
procedure FindDeclarations(Filename, Marker: string);
published
procedure TestFindDeclaration_Base;
procedure TestFindDeclaration_NestedClasses;
procedure TestFindDeclaration_ClassHelper;
end;
var
BugsTestSuite: TTestSuite;
FindDeclarationTestSuite: TTestSuite;
procedure AddToBugsTestSuite(ATest: TTest);
procedure AddToFindDeclarationTestSuite(ATestClass: TClass);
implementation
procedure AddToBugsTestSuite(ATest: TTest);
begin
BugsTestSuite.AddTest(ATest);
end;
procedure AddToFindDeclarationTestSuite(ATestClass: TClass);
begin
FindDeclarationTestSuite.AddTestSuiteFromClass(ATestClass);
end;
{ TTestFindDeclaration }
procedure TTestFindDeclaration.FindDeclarations(Filename,
Marker: string);
procedure PrependPath(Prefix: string; var Path: string);
begin
if Path<>'' then Path:='.'+Path;
Path:=Prefix+Path;
end;
var
Code: TCodeBuffer;
Tool: TCodeTool;
p: Integer;
StartPos: Integer;
ExpectedPath: String;
PathPos: Integer;
CursorPos, FoundCursorPos: TCodeXYPosition;
FoundTopLine: integer;
FoundTool: TFindDeclarationTool;
FoundCleanPos: Integer;
FoundNode: TCodeTreeNode;
FoundPath: String;
begin
Filename:=TrimAndExpandFilename(Filename);
Code:=CodeToolBoss.LoadFile(Filename,true,false);
if Code=nil then
raise Exception.Create('unable to load '+Filename);
if not CodeToolBoss.Explore(Code,Tool,true) then 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);
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;
FoundNode:=FoundNode.Parent;
end;
//debugln(['TTestFindDeclaration.FindDeclarations FoundPath=',FoundPath]);
AssertEquals('find declaration wrong at '+Tool.CleanPosToStr(StartPos-1),LowerCase(ExpectedPath),LowerCase(FoundPath));
end;
end;
end;
procedure TTestFindDeclaration.TestFindDeclaration_Base;
begin
FindDeclarations('fdt_classhelper.pas','declaration:');
end;
procedure TTestFindDeclaration.TestFindDeclaration_NestedClasses;
begin
FindDeclarations('fdt_nestedclasses.pas','declaration:');
end;
procedure TTestFindDeclaration.TestFindDeclaration_ClassHelper;
begin
FindDeclarations('fdt_classhelper.pas','declaration-classhelper:');
end;
initialization
GetTestRegistry.TestName := 'All tests';
BugsTestSuite := TTestSuite.Create('Bugs');
GetTestRegistry.AddTest(BugsTestSuite);
FindDeclarationTestSuite := TTestSuite.Create('Parser');
GetTestRegistry.AddTest(FindDeclarationTestSuite);
AddToFindDeclarationTestSuite(TTestFindDeclaration);
end.
|
