mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-27 15:40:40 +02:00
tests: codetools range scan
git-svn-id: trunk@29768 -
This commit is contained in:
parent
197952415b
commit
3c8976718d
@ -1,6 +1,7 @@
|
|||||||
{
|
{
|
||||||
Test with:
|
Test with:
|
||||||
./runtests --format=plain --suite=TestCTScanRange
|
./runtests --format=plain --suite=TestCTScanRange
|
||||||
|
./runtests --format=plain --suite=TestCTScanRangeAscending
|
||||||
}
|
}
|
||||||
unit TestCTRangeScan;
|
unit TestCTRangeScan;
|
||||||
|
|
||||||
@ -14,30 +15,36 @@ end.
|
|||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, fpcunit, testglobals,
|
Classes, SysUtils, fpcunit, testglobals, FileProcs, CodeToolManager,
|
||||||
CodeToolManager, CodeCache, CustomCodeTool, LinkScanner;
|
CodeCache, CustomCodeTool, LinkScanner, CodeTree, EventCodeTool;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
TCTRgSrcFlag = (
|
||||||
|
crsfWithProc1,
|
||||||
|
crsfWithCommentAtEnd,
|
||||||
|
crsfWithInitialization,
|
||||||
|
crsfWithFinalization
|
||||||
|
);
|
||||||
|
TCTRgSrcFlags = set of TCTRgSrcFlag;
|
||||||
|
|
||||||
{ TTestCodetoolsRangeScan }
|
{ TTestCodetoolsRangeScan }
|
||||||
|
|
||||||
TTestCodetoolsRangeScan = class(TTestCase)
|
TTestCodetoolsRangeScan = class(TTestCase)
|
||||||
protected
|
protected
|
||||||
|
function GetSource(Flags: TCTRgSrcFlags): string;
|
||||||
published
|
published
|
||||||
procedure TestCTScanRange;
|
procedure TestCTScanRange;
|
||||||
|
procedure TestCTScanRangeAscending;
|
||||||
|
procedure TestCTScanRangeDescending;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
{ TTestCodetoolsRangeScan }
|
{ TTestCodetoolsRangeScan }
|
||||||
|
|
||||||
procedure TTestCodetoolsRangeScan.TestCTScanRange;
|
function TTestCodetoolsRangeScan.GetSource(Flags: TCTRgSrcFlags): string;
|
||||||
var
|
|
||||||
Code: TCodeBuffer;
|
|
||||||
Tool: TCodeTool;
|
|
||||||
begin
|
begin
|
||||||
Code:=CodeToolBoss.CreateFile('TestRangeScan.pas');
|
Result:=
|
||||||
Code.Source:=
|
|
||||||
'unit TestRangeScan;'+LineEnding
|
'unit TestRangeScan;'+LineEnding
|
||||||
+'interface'+LineEnding
|
+'interface'+LineEnding
|
||||||
+'uses'+LineEnding
|
+'uses'+LineEnding
|
||||||
@ -46,11 +53,131 @@ begin
|
|||||||
+'implementation'+LineEnding
|
+'implementation'+LineEnding
|
||||||
+'uses'+LineEnding
|
+'uses'+LineEnding
|
||||||
+' Math;'+LineEnding
|
+' Math;'+LineEnding
|
||||||
+'const c = 3;'+LineEnding
|
+'const c = 3;'+LineEnding;
|
||||||
+'end.';
|
if crsfWithProc1 in Flags then
|
||||||
|
Result:=Result+'procedure Proc1;'+LineEnding
|
||||||
|
+'begin end;'+LineEnding;
|
||||||
|
if crsfWithInitialization in Flags then
|
||||||
|
Result:=Result+'initialization'+LineEnding;
|
||||||
|
if crsfWithFinalization in Flags then
|
||||||
|
Result:=Result+'finalization'+LineEnding;
|
||||||
|
Result:=Result+'end.';
|
||||||
|
if crsfWithCommentAtEnd in Flags then
|
||||||
|
Result:=Result+LineEnding
|
||||||
|
+'// end comment';
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestCodetoolsRangeScan.TestCTScanRange;
|
||||||
|
var
|
||||||
|
Code: TCodeBuffer;
|
||||||
|
Tool: TCodeTool;
|
||||||
|
RootNode: TCodeTreeNode;
|
||||||
|
TreeChangeStep: LongInt;
|
||||||
|
begin
|
||||||
|
Code:=CodeToolBoss.CreateFile('TestRangeScan.pas');
|
||||||
Tool:=CodeToolBoss.GetCodeToolForSource(Code,false,true) as TCodeTool;
|
Tool:=CodeToolBoss.GetCodeToolForSource(Code,false,true) as TCodeTool;
|
||||||
Tool.BuildTree(lsrInitializationStart);
|
|
||||||
|
// scan source
|
||||||
|
Code.Source:=GetSource([]);
|
||||||
|
debugln(['TTestCodetoolsRangeScan.TestCTScanRange INITIAL SCAN']);
|
||||||
|
Tool.BuildTree(lsrEnd);
|
||||||
|
RootNode:=Tool.Tree.Root;
|
||||||
|
TreeChangeStep:=Tool.TreeChangeStep;
|
||||||
|
AssertEquals('Step1: RootNode<>nil',true,RootNode<>nil);
|
||||||
|
//Tool.WriteDebugTreeReport;
|
||||||
|
|
||||||
|
// append a comment at end and scan again => this should result in no tree change
|
||||||
|
Code.Source:=GetSource([crsfWithCommentAtEnd]);
|
||||||
|
debugln(['TTestCodetoolsRangeScan.TestCTScanRange SCAN with comment at end']);
|
||||||
|
Tool.BuildTree(lsrEnd);
|
||||||
|
AssertEquals('Step2: RootNode=Tree.Root',true,RootNode=Tool.Tree.Root);
|
||||||
|
AssertEquals('Step2: TreeChangeStep=Tool.TreeChangeStep',true,TreeChangeStep=Tool.TreeChangeStep);
|
||||||
Tool.WriteDebugTreeReport;
|
Tool.WriteDebugTreeReport;
|
||||||
|
|
||||||
|
// insert a procedure in the implementation and scan again
|
||||||
|
// => this should result in a tree change, but the root node should be kept
|
||||||
|
Code.Source:=GetSource([crsfWithProc1]);
|
||||||
|
debugln(['TTestCodetoolsRangeScan.TestCTScanRange SCAN with new proc in implementation']);
|
||||||
|
Tool.BuildTree(lsrEnd);
|
||||||
|
AssertEquals('Step3: RootNode=Tree.Root',true,RootNode=Tool.Tree.Root);
|
||||||
|
AssertEquals('Step3: TreeChangeStep<>Tool.TreeChangeStep',true,TreeChangeStep<>Tool.TreeChangeStep);
|
||||||
|
Tool.WriteDebugTreeReport;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestCodetoolsRangeScan.TestCTScanRangeAscending;
|
||||||
|
var
|
||||||
|
Code: TCodeBuffer;
|
||||||
|
Tool: TEventsCodeTool;
|
||||||
|
r: TLinkScannerRange;
|
||||||
|
RootNode: TCodeTreeNode;
|
||||||
|
MinRange: TLinkScannerRange;
|
||||||
|
MaxRange: TLinkScannerRange;
|
||||||
|
begin
|
||||||
|
Code:=CodeToolBoss.CreateFile('TestRangeScan.pas');
|
||||||
|
Tool:=CodeToolBoss.GetCodeToolForSource(Code,false,true) as TCodeTool;
|
||||||
|
|
||||||
|
// scan source
|
||||||
|
Code.Source:=GetSource([crsfWithInitialization,crsfWithFinalization]);
|
||||||
|
RootNode:=nil;
|
||||||
|
MinRange:=low(TLinkScannerRange);
|
||||||
|
MaxRange:=high(TLinkScannerRange);
|
||||||
|
for r:=MinRange to MaxRange do begin
|
||||||
|
debugln(['TTestCodetoolsRangeScan.TestCTScanRangeAscending Range=',dbgs(r)]);
|
||||||
|
Tool.BuildTree(r);
|
||||||
|
if RootNode<>nil then begin
|
||||||
|
AssertEquals('RootNode must stay for ascending range '+dbgs(r),true,RootNode=Tool.Tree.Root);
|
||||||
|
end;
|
||||||
|
RootNode:=Tool.Tree.Root;
|
||||||
|
Tool.WriteDebugTreeReport;
|
||||||
|
case r of
|
||||||
|
lsrNone: ;
|
||||||
|
lsrInit: ;
|
||||||
|
lsrSourceType:
|
||||||
|
AssertEquals('source type scanned',true,RootNode<>nil);
|
||||||
|
lsrSourceName: ;
|
||||||
|
lsrInterfaceStart:
|
||||||
|
AssertEquals('interface start scanned',true,Tool.FindInterfaceNode<>nil);
|
||||||
|
lsrMainUsesSectionStart:
|
||||||
|
AssertEquals('main uses section start scanned',true,Tool.FindMainUsesSection<>nil);
|
||||||
|
lsrMainUsesSectionEnd:
|
||||||
|
AssertEquals('main uses section end scanned',true,Tool.FindMainUsesSection.FirstChild<>nil);
|
||||||
|
lsrImplementationStart:
|
||||||
|
AssertEquals('implementation start scanned',true,Tool.FindImplementationNode<>nil);
|
||||||
|
lsrImplementationUsesSectionStart:
|
||||||
|
AssertEquals('implementation uses section start scanned',true,Tool.FindImplementationUsesSection<>nil);
|
||||||
|
lsrImplementationUsesSectionEnd:
|
||||||
|
AssertEquals('implementation uses section end scanned',true,Tool.FindImplementationUsesSection.FirstChild<>nil);
|
||||||
|
lsrInitializationStart:
|
||||||
|
AssertEquals('initialization section start scanned',true,Tool.FindInitializationNode<>nil);
|
||||||
|
lsrFinalizationStart:
|
||||||
|
AssertEquals('finalization section start scanned',true,Tool.FindFinalizationNode<>nil);
|
||||||
|
lsrEnd:
|
||||||
|
AssertEquals('end. found',true,Tool.Tree.FindRootNode(ctnEndPoint)<>nil);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestCodetoolsRangeScan.TestCTScanRangeDescending;
|
||||||
|
var
|
||||||
|
Code: TCodeBuffer;
|
||||||
|
Tool: TEventsCodeTool;
|
||||||
|
MinRange: TLinkScannerRange;
|
||||||
|
MaxRange: TLinkScannerRange;
|
||||||
|
r: TLinkScannerRange;
|
||||||
|
begin
|
||||||
|
Code:=CodeToolBoss.CreateFile('TestRangeScan.pas');
|
||||||
|
Tool:=CodeToolBoss.GetCodeToolForSource(Code,false,true) as TCodeTool;
|
||||||
|
|
||||||
|
// scan source
|
||||||
|
Code.Source:=GetSource([]);
|
||||||
|
MinRange:=low(TLinkScannerRange);
|
||||||
|
MaxRange:=high(TLinkScannerRange);
|
||||||
|
for r:=MaxRange downto MinRange do begin
|
||||||
|
debugln(['TTestCodetoolsRangeScan.TestCTScanRangeAscending Range=',dbgs(r)]);
|
||||||
|
Tool.BuildTree(r);
|
||||||
|
AssertEquals('RootNode must stay for descending range '+dbgs(r),true,Tool.Tree.Root<>nil);
|
||||||
|
//Tool.WriteDebugTreeReport;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
|
Loading…
Reference in New Issue
Block a user