mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-07-23 02:06:15 +02:00
tests: added test for CompleteBlock
git-svn-id: trunk@30179 -
This commit is contained in:
parent
ab79608453
commit
d23a694b2c
@ -1,3 +1,10 @@
|
|||||||
|
{
|
||||||
|
Test all with:
|
||||||
|
./runtests --format=plain --suite=TTestCodetoolsCompleteBlock
|
||||||
|
|
||||||
|
Test specific with:
|
||||||
|
./runtests --format=plain --suite=TestCompleteBlockClassStart
|
||||||
|
}
|
||||||
unit TestCompleteBlock;
|
unit TestCompleteBlock;
|
||||||
|
|
||||||
{$mode objfpc}{$H+}
|
{$mode objfpc}{$H+}
|
||||||
@ -5,47 +12,33 @@ unit TestCompleteBlock;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
fpcunit, Classes, SysUtils;
|
Classes, SysUtils, fpcunit, testglobals, FileProcs, CodeToolManager,
|
||||||
|
CodeCache, CustomCodeTool;
|
||||||
|
|
||||||
type
|
type
|
||||||
{ TCodeBlocksTest }
|
|
||||||
|
|
||||||
TCodeBlocksTest = class(TTestCase)
|
{ TTestCodetoolsCompleteBlock }
|
||||||
protected
|
|
||||||
function CompareComplete(const InputDefines, ResultFile: String): Boolean;
|
TTestCodetoolsCompleteBlock = class(TTestCase)
|
||||||
published
|
public
|
||||||
procedure TestCompleteBlocks;
|
procedure TestCompleteBlocks;
|
||||||
|
procedure CompleteBlock(Src, ExpectedSrc: string;
|
||||||
|
OnlyIfCursorBlockIndented: boolean = false);
|
||||||
|
published
|
||||||
|
procedure TestCompleteBlockClassStart;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
{ TCodeBlocksTest }
|
{ TTestCodetoolsCompleteBlock }
|
||||||
|
|
||||||
function TCodeBlocksTest.CompareComplete(const InputFile, InputDefines, ResultFile: String): Boolean;
|
procedure TTestCodetoolsCompleteBlock.TestCompleteBlocks;
|
||||||
var
|
|
||||||
st : TStringList;
|
|
||||||
rs : TStringList;
|
|
||||||
|
|
||||||
function StripSpaceChars(const s: string): String;
|
procedure CompareComplete(a,b,c: string);
|
||||||
begin
|
begin
|
||||||
// removes all [#10,#13,#9, #32] chars, giving a line: "beginwriteln('helloworld');end."
|
writeln('CompareComplete ',a,',',b,',',c);
|
||||||
Result:=s;
|
|
||||||
for i:=length(Result) downto 1 do
|
|
||||||
if Result[i] in [#10,#13,#9,' '] then
|
|
||||||
System.Delete(Result,i,1);
|
|
||||||
end;
|
end;
|
||||||
begin
|
|
||||||
// ToDo: fix path to completeblock, InputFile nd ResultFile
|
|
||||||
st := GetProcessOutput('completeblock '+InputFile+' '+inputdefines); // reads all output from blockcompleted file
|
|
||||||
// remove debugging output and take only the new source
|
|
||||||
while (st.Count>0) and (st[0]<>'{%MainUnit unit1.pas}') do st.Delete(0);
|
|
||||||
// reads the correct result file
|
|
||||||
rs.LoadFromFile(resultfile);
|
|
||||||
// check result
|
|
||||||
AssertEquals(StripSpaceChars(st.text), StripSpaceChars(rs.text)); // compares resulting strings
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TCodeBlocksTest.TestCompleteBlocks;
|
|
||||||
begin
|
begin
|
||||||
CompareComplete('ifbeginelse1.inc','6 28 ifbeginelse fpcunit', 'ifbeginelse1_result.inc');
|
CompareComplete('ifbeginelse1.inc','6 28 ifbeginelse fpcunit', 'ifbeginelse1_result.inc');
|
||||||
CompareComplete('whilebegin1.inc','5 10 whilebegin fpcunit', 'whilebegin1_result.inc');
|
CompareComplete('whilebegin1.inc','5 10 whilebegin fpcunit', 'whilebegin1_result.inc');
|
||||||
@ -65,5 +58,69 @@ begin
|
|||||||
CompareComplete('tryif1.inc','4 6 tryif fpcunit', 'tryif1_result.inc');
|
CompareComplete('tryif1.inc','4 6 tryif fpcunit', 'tryif1_result.inc');
|
||||||
end;
|
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;
|
||||||
|
begin
|
||||||
|
AssertEquals('Src is empty',Trim(Src)<>'',true);
|
||||||
|
AssertEquals('ExpectedSrc is empty',Trim(ExpectedSrc)<>'',true);
|
||||||
|
if not (Src[length(Src)] in [#10,#13]) then Src:=Src+LineEnding;
|
||||||
|
|
||||||
|
ExpectedCode:=TCodeBuffer.Create;
|
||||||
|
try
|
||||||
|
// replace cursor | marker in Src
|
||||||
|
Code:=CodeToolBoss.CreateFile('TestCompleteBlock.pas');
|
||||||
|
p:=System.Pos('|',Src);
|
||||||
|
if p<1 then
|
||||||
|
AssertEquals('missing cursor | in test source: "'+dbgstr(Src)+'"',true,false);
|
||||||
|
System.Delete(Src,p,1);
|
||||||
|
Code.Source:=Src;
|
||||||
|
Code.AbsoluteToLineCol(p,Y,X);
|
||||||
|
|
||||||
|
// replace cursor | marker in ExpectedSrc
|
||||||
|
ep:=System.Pos('|',ExpectedSrc);
|
||||||
|
if ep<1 then
|
||||||
|
AssertEquals('missing cursor | in expected source: "'+dbgstr(ExpectedSrc)+'"',true,false);
|
||||||
|
System.Delete(ExpectedSrc,ep,1);
|
||||||
|
ExpectedCode.Source:=ExpectedSrc;
|
||||||
|
ExpectedCode.AbsoluteToLineCol(ep,eY,eX);
|
||||||
|
|
||||||
|
if not CodeToolBoss.CompleteBlock(Code,X,Y,OnlyIfCursorBlockIndented,
|
||||||
|
NewCode,NewX,NewY,NewTopLine)
|
||||||
|
then begin
|
||||||
|
AssertEquals('completing block failed src="'+dbgstr(Src)+'"',true,false);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
AssertEquals('CompleteBlock did no or the wrong completion: ',dbgstr(Trim(ExpectedSrc)),dbgstr(Trim(Code.Source)));
|
||||||
|
|
||||||
|
finally
|
||||||
|
ExpectedCode.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestCodetoolsCompleteBlock.TestCompleteBlockClassStart;
|
||||||
|
begin
|
||||||
|
CompleteBlock('type'+LineEnding
|
||||||
|
+' TTestClass = class(TObject)|',
|
||||||
|
'type'+LineEnding
|
||||||
|
+' TTestClass = class(TObject)'+LineEnding
|
||||||
|
+' |end;');
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
AddToCodetoolsTestSuite(TTestCodetoolsCompleteBlock);
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
@ -1,10 +1,14 @@
|
|||||||
{
|
{
|
||||||
Test with:
|
Test all with:
|
||||||
|
./runtests --format=plain --suite=TTestCodetoolsRangeScan
|
||||||
|
|
||||||
|
Test specific with:
|
||||||
./runtests --format=plain --suite=TestCTScanRange
|
./runtests --format=plain --suite=TestCTScanRange
|
||||||
./runtests --format=plain --suite=TestCTScanRangeAscending
|
./runtests --format=plain --suite=TestCTScanRangeAscending
|
||||||
./runtests --format=plain --suite=TestCTScanRangeDescending
|
./runtests --format=plain --suite=TestCTScanRangeDescending
|
||||||
./runtests --format=plain --suite=TestCTScanRangeProcModified
|
./runtests --format=plain --suite=TestCTScanRangeProcModified
|
||||||
./runtests --format=plain --suite=TestCTScanRangeImplementationToEnd
|
./runtests --format=plain --suite=TestCTScanRangeImplementationToEnd
|
||||||
|
./runtests --format=plain --suite=TestCTScanRangeInitializationModified
|
||||||
}
|
}
|
||||||
unit TestCTRangeScan;
|
unit TestCTRangeScan;
|
||||||
|
|
||||||
|
@ -26,7 +26,7 @@ uses
|
|||||||
{Unit needed to set the LCL version and widget set name}
|
{Unit needed to set the LCL version and widget set name}
|
||||||
LCLVersion, InterfaceBase, Interfaces,
|
LCLVersion, InterfaceBase, Interfaces,
|
||||||
// testing codetools
|
// testing codetools
|
||||||
TestCTXMLFixFragments, TestCTRangeScan, TestCTH2Pas;
|
TestCTXMLFixFragments, TestCTRangeScan, TestCTH2Pas, TestCompleteBlock;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user