mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-05 17:52:36 +02:00
425 lines
14 KiB
ObjectPascal
425 lines
14 KiB
ObjectPascal
{
|
|
Test all with:
|
|
./runtests --format=plain --suite=TTestCodetoolsCompleteBlock
|
|
|
|
Test specific with:
|
|
./runtests --format=plain --suite=TestCompleteBlockClassStart
|
|
./runtests --format=plain --suite=TestCompleteBlockBegin
|
|
./runtests --format=plain --suite=TestCompleteBlockRepeat
|
|
./runtests --format=plain --suite=TestCompleteBlockCase
|
|
./runtests --format=plain --suite=TestCompleteBlockTry
|
|
./runtests --format=plain --suite=TestCompleteBlockAsm
|
|
./runtests --format=plain --suite=TestCompleteBlockIf
|
|
}
|
|
unit TestCompleteBlock;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, fpcunit, testregistry, FileProcs,
|
|
CodeToolManager, CodeCache, CustomCodeTool;
|
|
|
|
type
|
|
|
|
{ TTestCodetoolsCompleteBlock }
|
|
|
|
TTestCodetoolsCompleteBlock = class(TTestCase)
|
|
private
|
|
function CreateFullSrc(Src: string; out Cursor: integer): string;
|
|
procedure TestCompleteBlocks;
|
|
public
|
|
procedure CompleteBlock(Src, ExpectedSrc: string;
|
|
OnlyIfCursorBlockIndented: boolean = false);
|
|
procedure CompleteBlock(Src: string; OnlyIfCursorBlockIndented: boolean = false);
|
|
procedure CompleteBlockFail(Src: string;
|
|
OnlyIfCursorBlockIndented: boolean = false);
|
|
published
|
|
procedure TestCompleteBlockClassStart;
|
|
procedure TestCompleteBlockBegin;
|
|
procedure TestCompleteBlockRepeat;
|
|
procedure TestCompleteBlockCase;
|
|
procedure TestCompleteBlockTry;
|
|
procedure TestCompleteBlockAsm;
|
|
procedure TestCompleteBlockIf;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ TTestCodetoolsCompleteBlock }
|
|
|
|
procedure TTestCodetoolsCompleteBlock.TestCompleteBlocks;
|
|
|
|
procedure CompareComplete(a,b,c: string);
|
|
begin
|
|
writeln('CompareComplete ',a,',',b,',',c);
|
|
end;
|
|
|
|
begin
|
|
CompareComplete('ifbeginelse1.inc','6 28 ifbeginelse fpcunit', 'ifbeginelse1_result.inc');
|
|
CompareComplete('whilebegin1.inc','5 10 whilebegin fpcunit', 'whilebegin1_result.inc');
|
|
CompareComplete('beginwithoutindent1.inc','4 21 beginwithoutindent fpcunit', 'beginwithoutindent1_result1.inc');
|
|
CompareComplete('beginwithoutindent1.inc','5 6 beginwithoutindent fpcunit', 'beginwithoutindent1_result2.inc');
|
|
CompareComplete('casecolon1.inc','5 5 casecolon fpcunit', 'casecolon1_result.inc');
|
|
CompareComplete('caseelseend1.inc','5 7 caseelseend fpcunit', 'caseelseend1_result.inc');
|
|
CompareComplete('caseend1.inc','4 12 caseend fpcunit', 'caseend1_result.inc');
|
|
CompareComplete('class1.inc','3 19 class fpcunit', 'class1_result.inc');
|
|
CompareComplete('ifbegin1.inc','4 21 ifbegin fpcunit', 'ifbegin1_result.inc');
|
|
CompareComplete('ifbeginelse1.inc','6 28 ifbeginelse fpcunit', 'ifbeginelse1_result.inc');
|
|
CompareComplete('procedurebegin1.inc','3 6 procedurebegin fpcunit', 'procedurebegin1_result.inc');
|
|
CompareComplete('procedurebeginend1.inc','4 8 procedurebeginend fpcunit', 'procedurebeginend1_result.inc');
|
|
CompareComplete('procedurebeginifbegin1.inc','11 74 procedurebeginifbegin fpcunit', 'procedurebeginifbegin1_result.inc');
|
|
CompareComplete('record1.inc','3 22 record fpcunit', 'record1_result1.inc');
|
|
CompareComplete('repeatifelse1.inc','11 18 repeatifelse fpcunit', 'repeatifelse1_result.inc');
|
|
CompareComplete('tryif1.inc','4 6 tryif fpcunit', 'tryif1_result.inc');
|
|
end;
|
|
|
|
function TTestCodetoolsCompleteBlock.CreateFullSrc(Src: string;
|
|
out Cursor: integer): string;
|
|
begin
|
|
Result:=Src;
|
|
{Result:='unit testcompleteblock;'+LineEnding
|
|
+'interface'+LineEnding
|
|
+Src;}
|
|
if not (Result[length(Result)] in [#10,#13]) then
|
|
Result:=Result+LineEnding;
|
|
Cursor:=System.Pos('|',Result);
|
|
System.Delete(Result,Cursor,1);
|
|
end;
|
|
|
|
procedure TTestCodetoolsCompleteBlock.CompleteBlock(Src, ExpectedSrc: string;
|
|
OnlyIfCursorBlockIndented: boolean);
|
|
var
|
|
Code: TCodeBuffer;
|
|
p: integer;
|
|
Y: integer;
|
|
X: integer;
|
|
NewCode: TCodeBuffer;
|
|
NewX: integer;
|
|
NewY: integer;
|
|
NewTopLine: integer;
|
|
ExpectedCode: TCodeBuffer;
|
|
ep: integer;
|
|
eY: integer;
|
|
eX: integer;
|
|
FullSrc: String;
|
|
FullExpectedSrc: String;
|
|
TrimExpected: String;
|
|
TrimResult: String;
|
|
begin
|
|
AssertEquals('Src is empty',Trim(Src)<>'',true);
|
|
AssertEquals('ExpectedSrc is empty',Trim(ExpectedSrc)<>'',true);
|
|
|
|
ExpectedCode:=TCodeBuffer.Create;
|
|
try
|
|
// replace cursor | marker in Src
|
|
Code:=CodeToolBoss.CreateFile('TestCompleteBlock.pas');
|
|
FullSrc:=CreateFullSrc(Src,p);
|
|
if p<1 then
|
|
AssertEquals('missing cursor | in test source: "'+dbgstr(Src)+'"',true,false);
|
|
Code.Source:=FullSrc;
|
|
Code.AbsoluteToLineCol(p,Y,X);
|
|
|
|
// replace cursor | marker in ExpectedSrc
|
|
FullExpectedSrc:=CreateFullSrc(ExpectedSrc,ep);
|
|
if ep<1 then
|
|
AssertEquals('missing cursor | in expected source: "'+dbgstr(ExpectedSrc)+'"',true,false);
|
|
ExpectedCode.Source:=FullExpectedSrc;
|
|
ExpectedCode.AbsoluteToLineCol(ep,eY,eX);
|
|
|
|
if not CodeToolBoss.CompleteBlock(Code,X,Y,OnlyIfCursorBlockIndented,
|
|
NewCode,NewX,NewY,NewTopLine)
|
|
then begin
|
|
AssertEquals('CodeToolBoss.CompleteBlock returned false for src="'+dbgstr(Src)+'"',true,false);
|
|
exit;
|
|
end;
|
|
TrimExpected:=dbgstr(Trim(FullExpectedSrc));
|
|
TrimResult:=dbgstr(Trim(Code.Source));
|
|
if TrimExpected<>TrimResult then begin
|
|
debugln(['TTestCodetoolsCompleteBlock.CompleteBlock FAILED Expected:']);
|
|
debugln(FullExpectedSrc);
|
|
debugln(['TTestCodetoolsCompleteBlock.CompleteBlock FAILED Found:']);
|
|
debugln(Code.Source);
|
|
debugln(['TTestCodetoolsCompleteBlock.CompleteBlock FAILED end']);
|
|
end;
|
|
AssertEquals('CompleteBlock did no or the wrong completion: ',TrimExpected,TrimResult);
|
|
|
|
finally
|
|
ExpectedCode.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TTestCodetoolsCompleteBlock.CompleteBlock(Src: string;
|
|
OnlyIfCursorBlockIndented: boolean);
|
|
begin
|
|
CompleteBlock(Src,Src,OnlyIfCursorBlockIndented);
|
|
end;
|
|
|
|
procedure TTestCodetoolsCompleteBlock.CompleteBlockFail(Src: string;
|
|
OnlyIfCursorBlockIndented: boolean);
|
|
var
|
|
Code: TCodeBuffer;
|
|
p: integer;
|
|
FullSrc: String;
|
|
Y: integer;
|
|
X: integer;
|
|
NewCode: TCodeBuffer;
|
|
NewX: integer;
|
|
NewY: integer;
|
|
NewTopLine: integer;
|
|
begin
|
|
AssertEquals('Src is empty',Trim(Src)<>'',true);
|
|
|
|
// replace cursor | marker in Src
|
|
Code:=CodeToolBoss.CreateFile('TestCompleteBlock.pas');
|
|
FullSrc:=CreateFullSrc(Src,p);
|
|
if p<1 then
|
|
AssertEquals('missing cursor | in test source: "'+dbgstr(Src)+'"',true,false);
|
|
Code.Source:=FullSrc;
|
|
Code.AbsoluteToLineCol(p,Y,X);
|
|
|
|
if CodeToolBoss.CompleteBlock(Code,X,Y,OnlyIfCursorBlockIndented,
|
|
NewCode,NewX,NewY,NewTopLine)
|
|
then begin
|
|
debugln(['TTestCodetoolsCompleteBlock.CompleteBlockFail completion: ',dbgstr(Code.Source)]);
|
|
AssertEquals('CodeToolBoss.CompleteBlock returned true for incompletable src="'+dbgstr(Src)+'"',true,false);
|
|
end;
|
|
end;
|
|
|
|
procedure TTestCodetoolsCompleteBlock.TestCompleteBlockClassStart;
|
|
begin
|
|
CompleteBlock('type'+LineEnding
|
|
+' TTestClass = class(TObject)|',
|
|
'type'+LineEnding
|
|
+' TTestClass = class(TObject)'+LineEnding
|
|
+' |end;');
|
|
CompleteBlock('type'+LineEnding
|
|
+' TTestClass = class(TObject)|'+LineEnding
|
|
+' TSecondClass =',
|
|
'type'+LineEnding
|
|
+' TTestClass = class(TObject)'+LineEnding
|
|
+' |end;'+LineEnding
|
|
+LineEnding
|
|
+' TSecondClass =');
|
|
CompleteBlock('type'+LineEnding
|
|
+' TTestClass = class(TObject)|'+LineEnding
|
|
+'implementation',
|
|
'type'+LineEnding
|
|
+' TTestClass = class(TObject)'+LineEnding
|
|
+' |end;'+LineEnding
|
|
+LineEnding
|
|
+'implementation');
|
|
end;
|
|
|
|
procedure TTestCodetoolsCompleteBlock.TestCompleteBlockBegin;
|
|
begin
|
|
CompleteBlock('begin'+LineEnding
|
|
+' begin|'+LineEnding
|
|
+'end.',
|
|
'begin'+LineEnding
|
|
+' begin|'+LineEnding
|
|
+' end;'+LineEnding
|
|
+'end.');
|
|
CompleteBlock('begin'+LineEnding
|
|
+' while do begin|'+LineEnding
|
|
+'end.',
|
|
'begin'+LineEnding
|
|
+' while do begin|'+LineEnding
|
|
+' end;'+LineEnding
|
|
+'end.');
|
|
CompleteBlock('begin'+LineEnding
|
|
+' while do'+LineEnding
|
|
+' begin|'+LineEnding
|
|
+'end.',
|
|
'begin'+LineEnding
|
|
+' while do'+LineEnding
|
|
+' begin|'+LineEnding
|
|
+' end;'+LineEnding
|
|
+'end.');
|
|
CompleteBlock('begin'+LineEnding
|
|
+' begin|'+LineEnding
|
|
+' writeln;'+LineEnding
|
|
+'end.',
|
|
'begin'+LineEnding
|
|
+' begin|'+LineEnding
|
|
+' writeln;'+LineEnding
|
|
+' end;'+LineEnding
|
|
+'end.');
|
|
CompleteBlock('begin'+LineEnding
|
|
+' begin|'+LineEnding
|
|
+' writeln;'+LineEnding
|
|
+'end.',
|
|
'begin'+LineEnding
|
|
+' begin|'+LineEnding
|
|
+' end;'+LineEnding
|
|
+' writeln;'+LineEnding
|
|
+'end.');
|
|
{ Todo: Not implemented yet
|
|
CompleteBlock('procedure a;'+LineEnding
|
|
+'begin|'+LineEnding
|
|
+'begin'+LineEnding
|
|
+'end.',
|
|
'procedure a;'+LineEnding
|
|
+'begin|'+LineEnding
|
|
+'end;'+LineEnding
|
|
+'begin'+LineEnding
|
|
+'end.');}
|
|
end;
|
|
|
|
procedure TTestCodetoolsCompleteBlock.TestCompleteBlockRepeat;
|
|
begin
|
|
CompleteBlock('begin'+LineEnding
|
|
+' repeat|'+LineEnding
|
|
+'end.',
|
|
'begin'+LineEnding
|
|
+' repeat|'+LineEnding
|
|
+' until ;'+LineEnding
|
|
+'end.');
|
|
CompleteBlock(
|
|
'begin'+LineEnding
|
|
+' if FindFirstUTF8(Dir+FileMask,faAnyFile,FileInfo)=0 then begin'+LineEnding
|
|
+' repeat'+LineEnding
|
|
+' // check if special file'+LineEnding
|
|
+' if (FileInfo.Name=''.'') or (FileInfo.Name=''..'') or (FileInfo.Name='''')'+LineEnding
|
|
+' then'+LineEnding
|
|
+' continue;'+LineEnding
|
|
+' |'+LineEnding
|
|
+' if FilenameIsPascalUnit(FileInfo.Name,false) then begin'+LineEnding
|
|
+' List.Add(Dir+FileInfo.Name);'+LineEnding
|
|
+' end else if (FileInfo.Attr and faDirectory)>0 then begin'+LineEnding
|
|
+' CollectUnits(Dir+);'+LineEnding
|
|
+' end;'+LineEnding
|
|
+' until FindNextUTF8(FileInfo)<>0;'+LineEnding
|
|
+' end;'+LineEnding
|
|
+' FindCloseUTF8(FileInfo);'+LineEnding);
|
|
end;
|
|
|
|
procedure TTestCodetoolsCompleteBlock.TestCompleteBlockCase;
|
|
begin
|
|
CompleteBlock('begin'+LineEnding
|
|
+' case of|'+LineEnding
|
|
+'end.',
|
|
'begin'+LineEnding
|
|
+' case of|'+LineEnding
|
|
+' end;'+LineEnding
|
|
+'end.');
|
|
CompleteBlock('begin'+LineEnding
|
|
+' case of|'+LineEnding
|
|
+'end.',
|
|
'begin'+LineEnding
|
|
+' case of|'+LineEnding
|
|
+' end;'+LineEnding
|
|
+'end.');
|
|
end;
|
|
|
|
procedure TTestCodetoolsCompleteBlock.TestCompleteBlockTry;
|
|
begin
|
|
CompleteBlock('begin'+LineEnding
|
|
+' try|'+LineEnding
|
|
+'end.',
|
|
'begin'+LineEnding
|
|
+' try|'+LineEnding
|
|
+' finally'+LineEnding
|
|
+' end;'+LineEnding
|
|
+'end.');
|
|
CompleteBlock('begin'+LineEnding
|
|
+' try'+LineEnding
|
|
+' finally|'+LineEnding
|
|
+'end.',
|
|
'begin'+LineEnding
|
|
+' try'+LineEnding
|
|
+' finally|'+LineEnding
|
|
+' end;'+LineEnding
|
|
+'end.');
|
|
CompleteBlock('begin'+LineEnding
|
|
+' try'+LineEnding
|
|
+' except|'+LineEnding
|
|
+'end.',
|
|
'begin'+LineEnding
|
|
+' try'+LineEnding
|
|
+' except|'+LineEnding
|
|
+' end;'+LineEnding
|
|
+'end.');
|
|
{ ToDo:
|
|
if True then
|
|
i:=1
|
|
else
|
|
if True then
|
|
if True then
|
|
i:=2
|
|
else
|
|
i:=3
|
|
else
|
|
i:=4;
|
|
|
|
if True then Caption:='retz'
|
|
else if False then Caption:='qretz';
|
|
|
|
try
|
|
|
|
except
|
|
on e: Exception do begin
|
|
fErrorMsg:=e.Message;
|
|
end;
|
|
else begin
|
|
fErrorMsg:='Error';
|
|
end;
|
|
MyResult:=mrAbort;
|
|
end;
|
|
try
|
|
try
|
|
finally
|
|
|
|
end;
|
|
except
|
|
on E: Exception do begin
|
|
|
|
end;
|
|
end;
|
|
}
|
|
end;
|
|
|
|
procedure TTestCodetoolsCompleteBlock.TestCompleteBlockAsm;
|
|
begin
|
|
CompleteBlock('begin'+LineEnding
|
|
+' asm|'+LineEnding
|
|
+'end.',
|
|
'begin'+LineEnding
|
|
+' asm|'+LineEnding
|
|
+' end;'+LineEnding
|
|
+'end.');
|
|
end;
|
|
|
|
procedure TTestCodetoolsCompleteBlock.TestCompleteBlockIf;
|
|
begin
|
|
CompleteBlock('begin'+LineEnding
|
|
+' if then begin|'+LineEnding
|
|
+'end.',
|
|
'begin'+LineEnding
|
|
+' if then begin|'+LineEnding
|
|
+' end;'+LineEnding
|
|
+'end.');
|
|
CompleteBlock('begin'+LineEnding
|
|
+' if then begin|'+LineEnding
|
|
+' else'+LineEnding
|
|
+'end.',
|
|
'begin'+LineEnding
|
|
+' if then begin|'+LineEnding
|
|
+' end'+LineEnding
|
|
+' else'+LineEnding
|
|
+'end.');
|
|
CompleteBlockFail('begin'+LineEnding
|
|
+' try'+LineEnding
|
|
+' if|'+LineEnding
|
|
+' finally'+LineEnding
|
|
+' end;'+LineEnding
|
|
+'end.');
|
|
end;
|
|
|
|
initialization
|
|
RegisterTest(TTestCodetoolsCompleteBlock);
|
|
|
|
end.
|
|
|