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

Merge branch 'Issue40592_sealed_objects' into 'main'

Browse Source 
Codetools: solve issue #40592 parsing sealed/abstract objects.

See merge request freepascal.org/lazarus/lazarus!272
This commit is contained in:
Maxim Ganetsky 2024-03-03 15:58:50 +00:00
commit 9ea1307389
2 changed files with 20 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
components/codetools/pascalparsertool.pas
View File

@ -4699,13 +4699,13 @@ begin
SaveRaiseCharExpectedButAtomFound(20170421195756,';');
end else begin
if CurPos.Flag=cafWord then begin
if (ClassDesc=ctnClass) and UpAtomIs('SEALED') then begin
if (ClassDesc in [ctnClass,ctnObject]) and UpAtomIs('SEALED') then begin
CreateChildNode;
CurNode.Desc:=ctnClassSealed;
CurNode.EndPos:=CurPos.EndPos;
EndChildNode;
ReadNextAtom;
end else if (ClassDesc=ctnClass) and UpAtomIs('ABSTRACT') then begin
end else if (ClassDesc in [ctnClass,ctnObject]) and UpAtomIs('ABSTRACT') then begin
CreateChildNode;
CurNode.Desc:=ctnClassAbstract;
CurNode.EndPos:=CurPos.EndPos;

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

@ -61,6 +61,7 @@ type
procedure TestParseMultilineStringDelphi;
procedure TestParseUnderscoreIsSeparator;
procedure TestParseDirective_IF_SizeOf_Char;
procedure TestParseObjectSealedAbstract;
end;
implementation
@ -698,6 +699,23 @@ begin
ParseModule;
end;
procedure TTestPascalParser.TestParseObjectSealedAbstract;
begin
StartProgram;
Add([
'type',
'TFoo = object',
'end;',
'TBar = object sealed (TFoo)',
' Field1:boolean;',
'end;',
'TBar2 = object abstract (TFoo)',
' Field1:boolean;',
'end;',
'begin']);
ParseModule;
end;
initialization
RegisterTest(TTestPascalParser);