mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-16 23:23:03 +02:00
codetools: test scan unit change a word and scan again
git-svn-id: trunk@56011 -
This commit is contained in:
parent
fccd4f7546
commit
dfa2c1d3b6
@ -23,7 +23,7 @@ interface
|
|||||||
uses
|
uses
|
||||||
Classes, SysUtils, fpcunit, testregistry, FileProcs,
|
Classes, SysUtils, fpcunit, testregistry, FileProcs,
|
||||||
CodeToolManager, CodeCache, CustomCodeTool, LinkScanner, CodeTree,
|
CodeToolManager, CodeCache, CustomCodeTool, LinkScanner, CodeTree,
|
||||||
EventCodeTool, PascalParserTool;
|
EventCodeTool, PascalParserTool, BasicCodeTools;
|
||||||
|
|
||||||
const
|
const
|
||||||
ctrsCommentOfProc1 = 'comment of Proc1';
|
ctrsCommentOfProc1 = 'comment of Proc1';
|
||||||
@ -59,6 +59,7 @@ type
|
|||||||
procedure TestCTScanRangeLibraryInitializationModified;
|
procedure TestCTScanRangeLibraryInitializationModified;
|
||||||
procedure TestCTScanRangeScannerAtEnd;
|
procedure TestCTScanRangeScannerAtEnd;
|
||||||
procedure TestCTScanRangeProgramNoName;
|
procedure TestCTScanRangeProgramNoName;
|
||||||
|
procedure TestCTScanRangeUnitModified;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@ -235,7 +236,10 @@ begin
|
|||||||
lsrSourceType:
|
lsrSourceType:
|
||||||
AssertEquals('source type scanned',true,RootNode<>nil);
|
AssertEquals('source type scanned',true,RootNode<>nil);
|
||||||
lsrSourceName:
|
lsrSourceName:
|
||||||
AssertEquals('source name scanned',true,RootNode<>nil);
|
begin
|
||||||
|
AssertEquals('source name scanned',true,RootNode.FirstChild<>nil);
|
||||||
|
AssertEquals('source name found',true,RootNode.FirstChild.Desc=ctnSrcName);
|
||||||
|
end;
|
||||||
lsrInterfaceStart:
|
lsrInterfaceStart:
|
||||||
AssertEquals('interface start scanned',true,Tool.FindInterfaceNode<>nil);
|
AssertEquals('interface start scanned',true,Tool.FindInterfaceNode<>nil);
|
||||||
lsrMainUsesSectionStart:
|
lsrMainUsesSectionStart:
|
||||||
@ -449,6 +453,52 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TTestCodetoolsRangeScan.TestCTScanRangeUnitModified;
|
||||||
|
// scan a unit
|
||||||
|
// change each lowercase word and scan again
|
||||||
|
var
|
||||||
|
Code: TCodeBuffer;
|
||||||
|
Tool: TCodeTool;
|
||||||
|
p, AtomStart: integer;
|
||||||
|
Src: String;
|
||||||
|
begin
|
||||||
|
Code:=CodeToolBoss.CreateFile('TestRangeScan.pas');
|
||||||
|
Tool:=CodeToolBoss.GetCodeToolForSource(Code,false,true) as TCodeTool;
|
||||||
|
|
||||||
|
Src:=
|
||||||
|
'unit testrangescan;'+LineEnding
|
||||||
|
+'interface'+LineEnding
|
||||||
|
+'uses sysutils;'+LineEnding
|
||||||
|
+'implementation'+LineEnding
|
||||||
|
+'initialization'+LineEnding
|
||||||
|
+'write;'+LineEnding
|
||||||
|
+'finalization'+LineEnding
|
||||||
|
+'writeln;'+LineEnding
|
||||||
|
+'end.'+LineEnding;
|
||||||
|
Code.Source:=Src;
|
||||||
|
Tool.BuildTree(lsrEnd);
|
||||||
|
p:=1;
|
||||||
|
repeat
|
||||||
|
ReadRawNextPascalAtom(Src,p,AtomStart);
|
||||||
|
if p>=length(Src) then break;
|
||||||
|
if Src[AtomStart] in ['a'..'z'] then begin
|
||||||
|
try
|
||||||
|
{$IFDEF VerboseTestCTRangeScan}
|
||||||
|
debugln(['TTestCodetoolsRangeScan.TestCTScanRangeAscending Word="',GetIdentifier(@Src[AtomStart]),'"']);
|
||||||
|
{$ENDIF}
|
||||||
|
Src[AtomStart]:=upcase(Src[AtomStart]);
|
||||||
|
Code.Source:=Src;
|
||||||
|
Tool.BuildTree(lsrEnd);
|
||||||
|
except
|
||||||
|
on E: Exception do begin
|
||||||
|
debugln(['TTestCodetoolsRangeScan.TestCTScanRangeUnitModified word="'+GetIdentifier(@Src[AtomStart])+'" ',E.ClassName,' Msg=',E.Message]);
|
||||||
|
Fail(E.Message);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
until false;
|
||||||
|
end;
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
RegisterTest(TTestCodetoolsRangeScan);
|
RegisterTest(TTestCodetoolsRangeScan);
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user