mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-10 15:03:04 +02:00
123 lines
2.4 KiB
ObjectPascal
123 lines
2.4 KiB
ObjectPascal
{
|
|
Test all with:
|
|
./runtests --format=plain --suite=TTestPascalParser
|
|
|
|
Test specific with:
|
|
./runtests --format=plain --suite=TestRecord_ClassOperators
|
|
}
|
|
unit TestPascalParser;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, CodeToolManager, CodeCache,
|
|
LazLogger, fpcunit, testregistry, TestGlobals;
|
|
|
|
type
|
|
|
|
{ TTestPascalParser }
|
|
|
|
TTestPascalParser = class(TTestCase)
|
|
private
|
|
FCode: TCodeBuffer;
|
|
protected
|
|
procedure SetUp; override;
|
|
procedure TearDown; override;
|
|
public
|
|
procedure Add(const s: string);
|
|
procedure Add(Args: array of const);
|
|
procedure StartUnit;
|
|
procedure StartProgram;
|
|
procedure ParseModule;
|
|
property Code: TCodeBuffer read FCode;
|
|
published
|
|
procedure TestRecord_ClassOperators;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ TTestPascalParser }
|
|
|
|
procedure TTestPascalParser.SetUp;
|
|
begin
|
|
inherited SetUp;
|
|
FCode:=CodeToolBoss.CreateFile('test1.pas');
|
|
end;
|
|
|
|
procedure TTestPascalParser.TearDown;
|
|
begin
|
|
inherited TearDown;
|
|
end;
|
|
|
|
procedure TTestPascalParser.Add(const s: string);
|
|
begin
|
|
FCode.Source:=FCode.Source+s+LineEnding;
|
|
end;
|
|
|
|
procedure TTestPascalParser.Add(Args: array of const);
|
|
begin
|
|
FCode.Source:=FCode.Source+LinesToStr(Args);
|
|
end;
|
|
|
|
procedure TTestPascalParser.StartUnit;
|
|
begin
|
|
Add('unit test1;');
|
|
Add('');
|
|
Add('{$mode objfpc}{$H+}');
|
|
Add('');
|
|
Add('interface');
|
|
Add('');
|
|
end;
|
|
|
|
procedure TTestPascalParser.StartProgram;
|
|
begin
|
|
Add('program test1;');
|
|
Add('');
|
|
Add('{$mode objfpc}{$H+}');
|
|
Add('');
|
|
end;
|
|
|
|
procedure TTestPascalParser.ParseModule;
|
|
var
|
|
Tool: TCodeTool;
|
|
Cnt, i: Integer;
|
|
begin
|
|
Add('end.');
|
|
if not CodeToolBoss.Explore(Code,Tool,true) then begin
|
|
debugln(Code.Filename+'------------------------------------------');
|
|
if CodeToolBoss.ErrorLine>0 then
|
|
Cnt:=CodeToolBoss.ErrorLine
|
|
else
|
|
Cnt:=Code.LineCount;
|
|
for i:=1 to Cnt do
|
|
debugln(Format('%:4d: ',[i]),Code.GetLine(i-1,false));
|
|
debugln('Error: '+CodeToolBoss.ErrorDbgMsg);
|
|
Fail('PascalParser failed: '+CodeToolBoss.ErrorMessage);
|
|
end;
|
|
end;
|
|
|
|
procedure TTestPascalParser.TestRecord_ClassOperators;
|
|
begin
|
|
StartProgram;
|
|
Add([
|
|
'type',
|
|
' TMyRecord = record',
|
|
' class operator Implicit(t: TMyRecord): TMyRecord;',
|
|
' end;',
|
|
'',
|
|
'class operator TMyRecord.Implicit(t: TMyRecord): TMyRecord;',
|
|
'begin end;',
|
|
'',
|
|
'begin'
|
|
]);
|
|
ParseModule;
|
|
end;
|
|
|
|
initialization
|
|
AddToPascalTestSuite(TTestPascalParser);
|
|
|
|
end.
|
|
|