From 1d23ee88b81dd3b8ab55113d5d7b7149b52a6db5 Mon Sep 17 00:00:00 2001 From: mattias Date: Sat, 12 Mar 2022 20:08:35 +0100 Subject: [PATCH] fcl-passrc: fixed parsing class var var (cherry picked from commit 14ae44c362cbb78cafd5354137a3cf86e5f5fa0f) --- packages/fcl-passrc/src/pparser.pp | 34 ++++++++++------------- packages/fcl-passrc/tests/tcclasstype.pas | 30 ++++++++++++++++++++ 2 files changed, 44 insertions(+), 20 deletions(-) diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp index ddaf74ba0e..fa26e65e9e 100644 --- a/packages/fcl-passrc/src/pparser.pp +++ b/packages/fcl-passrc/src/pparser.pp @@ -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 diff --git a/packages/fcl-passrc/tests/tcclasstype.pas b/packages/fcl-passrc/tests/tcclasstype.pas index 325c612c2d..cfc4614ee2 100644 --- a/packages/fcl-passrc/tests/tcclasstype.pas +++ b/packages/fcl-passrc/tests/tcclasstype.pas @@ -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);