paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-19 22:29:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: test CheckLFM: parse unitname

Browse Source
This commit is contained in:
mattias 2023-01-17 22:49:58 +01:00
parent 112a42d2d3
commit 4c53c90895
2 changed files with 20 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
components/codetools/lfmtrees.pas
View File

@ -732,6 +732,7 @@ procedure TLFMTree.ProcessObject;
var
ObjectNode: TLFMObjectNode;
ObjectStartLine: LongInt;
HasDot: Boolean;
begin
CreateChildNode(TLFMObjectNode);
ObjectNode:=TLFMObjectNode(CurNode);
@ -760,14 +761,16 @@ begin
ObjectNode.TypeNamePosition:=TokenStart;
ObjectNode.ChildPos := -1;
NextToken;
HasDot:=false;
while Parser.Token = '.' do begin
HasDot:=true;
NextToken;
Parser.CheckToken(toSymbol);
ObjectNode.TypeName := ObjectNode.TypeName+'.'+Parser.TokenString;
NextToken;
end;
if Parser.Token = ':' then begin
if (not HasDot) and (Parser.Token = ':') then begin
// Name:TypeName
NextToken;
Parser.CheckToken(toSymbol);

18
components/codetools/tests/testlfmtrees.pas
View File

@ -46,7 +46,8 @@ type
TTestLFMTrees = class(TCustomTestLFMTrees)
published
procedure LFMEmptyForm;
procedure LFMButton1;
procedure LFMChildComponent;
procedure LFMUnitname;
end;
implementation
@ -272,7 +273,7 @@ begin
CheckLFM;
end;
procedure TTestLFMTrees.LFMButton1;
procedure TTestLFMTrees.LFMChildComponent;
begin
AddControls;
AddFormUnit(['Button1: TButton']);
@ -288,6 +289,19 @@ begin
CheckLFM;
end;
procedure TTestLFMTrees.LFMUnitname;
begin
AddControls;
AddFormUnit(['Button1: TButton']);
FLFMCode:=AddSource('unit1.lfm',LinesToStr([
'object Form1: Controls/TForm1',
' object Button1: Controls/TButton',
' end',
'end'
]));
CheckLFM;
end;
initialization
RegisterTest(TTestLFMTrees);