paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-15 07:29:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: fixed parsing class var var

Browse Source 
(cherry picked from commit 14ae44c362)
This commit is contained in:
mattias 2022-03-12 20:08:35 +01:00 committed by Mattias Gaertner
parent 86f8674dfa
commit 1d23ee88b8
2 changed files with 44 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
packages/fcl-passrc/src/pparser.pp
View File

@ -7743,6 +7743,7 @@ begin
LastToken:=CurToken;
while (CurToken<>tkEnd) do
begin
haveClass:=LastToken=tkclass;
//writeln('TPasParser.ParseClassMembers LastToken=',LastToken,' CurToken=',CurToken,' haveClass=',haveClass,' CurSection=',CurSection);
case CurToken of
tkType:
@ -7776,18 +7777,17 @@ begin
CurSection:=stNone;
end;
tkVar:
if not (CurSection in [stVar,stClassVar]) then
begin
if (AType.ObjKind in okWithFields)
or (haveClass and (AType.ObjKind in okAllHelpers)) then
// ok
else
ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['VAR',ObjKindNames[AType.ObjKind]]);
if LastToken=tkClass then
CurSection:=stClassVar
else
CurSection:=stVar;
end;
begin
if (AType.ObjKind in okWithFields)
or (haveClass and (AType.ObjKind in okAllHelpers)) then
// ok
else
ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['VAR',ObjKindNames[AType.ObjKind]]);
if haveClass then
CurSection:=stClassVar
else
CurSection:=stVar;
end;
tkIdentifier:
if CheckVisibility(CurTokenString,CurVisibility,(AType.ObjKind=okObjcProtocol)) then
CurSection:=stNone
@ -7806,17 +7806,15 @@ begin
begin
if not (AType.ObjKind in okWithFields) then
ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
ParseClassFields(AType,CurVisibility,false);
if Curtoken=tkEnd then // case Ta = Class x : String end;
UngetToken;
HaveClass:=False;
end;
stClassVar:
begin
if not (AType.ObjKind in okWithClassFields) then
ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
HaveClass:=False;
ParseClassFields(AType,CurVisibility,true);
end;
else
Raise Exception.Create('Internal error 201704251415');
@ -7841,7 +7839,6 @@ begin
ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['destructor',ObjKindNames[AType.ObjKind]]);
end;
ProcessMethod(AType,HaveClass,CurVisibility,false);
haveClass:=False;
end;
tkProcedure,tkFunction:
begin
@ -7870,7 +7867,6 @@ begin
end
else
ProcessMethod(AType,HaveClass,CurVisibility,false);
haveClass:=False;
end;
tkgeneric:
begin
@ -7908,7 +7904,6 @@ begin
end;
SaveComments;
HaveClass:=True;
curSection:=stNone;
end;
tkProperty:
@ -7920,7 +7915,6 @@ begin
PropEl:=ParseProperty(AType,CurtokenString,CurVisibility,HaveClass);
AType.Members.Add(PropEl);
Engine.FinishScope(stDeclaration,PropEl);
HaveClass:=False;
end;
tkSquaredBraceOpen:
if msPrefixedAttributes in CurrentModeswitches then

30
packages/fcl-passrc/tests/tcclasstype.pas
View File

@ -93,6 +93,7 @@ type
procedure TestNoVarFields;
procedure TestVarClassFunction;
procedure TestClassVarClassFunction;
procedure TestClassVarVarField;
Procedure TestTwoFieldsVisibility;
Procedure TestConstProtectedEnd;
Procedure TestTypeProtectedEnd;
@ -867,6 +868,35 @@ begin
AssertVisibility(visPublic,Members[0]);
end;
procedure TTestClassType.TestClassVarVarField;
begin
StartVisibility(visPublic);
FDecl.Add('class var');
AddMember('a : integer');
FDecl.Add('var');
AddMember('b : integer');
FDecl.Add('class var');
AddMember('c : integer');
ParseClass;
AssertEquals('member count',3,TheClass.members.Count);
AssertNotNull('Have field',Field1);
AssertMemberName('a',Members[0]);
AssertMemberType(TPasVariable,Members[0]);
AssertTrue('first field is class var',vmClass in TPasVariable(Members[0]).VarModifiers);
AssertVisibility(visPublic,Members[0]);
AssertMemberName('b',Members[1]);
AssertMemberType(TPasVariable,Members[1]);
AssertFalse('second field is var',vmClass in TPasVariable(Members[1]).VarModifiers);
AssertVisibility(visPublic,Members[1]);
AssertMemberName('c',Members[2]);
AssertMemberType(TPasVariable,Members[2]);
AssertTrue('third field is class var',vmClass in TPasVariable(Members[2]).VarModifiers);
AssertVisibility(visPublic,Members[2]);
end;
procedure TTestClassType.TestTwoFieldsVisibility;
begin
StartVisibility(visPublic);