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
|
{
Test with:
./parsertest --format=plain --suite=TTestParseFPCTestUnits
./parsertest --format=plain --suite=TestParse_ugenconstraints
./parsertest --format=plain --suite=TestParse_PT_Files
}
unit ParserTBase;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, CodeToolManager, ExprEval, CodeCache, LazFileUtils,
LazLogger, fpcunit, testregistry;
type
{ TTestParseFPCTestUnits }
TTestParseFPCTestUnits = class(TTestCase)
private
procedure TestParseFile(aFilename: string);
published
procedure TestParse_ugenconstraints;
procedure TestParse_PT_Files;
end;
var
BugsTestSuite: TTestSuite;
ParserTestSuite: TTestSuite;
procedure AddToBugsTestSuite(ATest: TTest);
procedure AddToParserTestSuite(ATestClass: TClass);
implementation
procedure AddToBugsTestSuite(ATest: TTest);
begin
BugsTestSuite.AddTest(ATest);
end;
procedure AddToParserTestSuite(ATestClass: TClass);
begin
ParserTestSuite.AddTestSuiteFromClass(ATestClass);
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;
Filename: String;
Code: TCodeBuffer;
Tool: TCodeTool;
begin
FPCDir:=TrimFilename(CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'FPCSrcDir']);
if not DirPathExists(FPCDir) then
raise Exception.Create('FPCDIR not found: '+FPCDir);
Filename:=AppendPathDelim(FPCDir)+'tests/test/ugenconstraints.pas';
//debugln(['TTestParseFPCTestUnits.TestParse_ugenconstraints ',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
debugln(['TTestParseFPCTestUnits.TestParse_ugenconstraints ',CodeToolBoss.ErrorMessage]);
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');
GetTestRegistry.AddTest(BugsTestSuite);
ParserTestSuite := TTestSuite.Create('Parser');
GetTestRegistry.AddTest(ParserTestSuite);
AddToParserTestSuite(TTestParseFPCTestUnits);
end.
|
