diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp index 24116c874b..a888682e5d 100644 --- a/packages/fcl-passrc/src/pparser.pp +++ b/packages/fcl-passrc/src/pparser.pp @@ -5070,6 +5070,10 @@ end; // Starts after the opening bracket token procedure TPasParser.ParseArgList(Parent: TPasElement; Args: TFPList; EndToken: TToken); + +var + HasRef: Boolean; + Function GetParamName : string; begin @@ -5084,6 +5088,41 @@ procedure TPasParser.ParseArgList(Parent: TPasElement; Args: TFPList; EndToken: ParseExcTokenError('identifier') end; end; + + Procedure ParseAttr(Peek : Boolean); + + begin + HasRef:=False; + NextToken; + While CurToken=tkIdentifier do + begin + HasRef:=HasRef or CurTokenIsIdentifier('ref'); + NextToken; + // We ignore the attribute value for the moment. + if CurToken=tkComma then + NextToken; + end; + CheckToken(tkSquaredBraceClose); + if not Peek then + NextToken; + end; + + Function CheckAttributes(peek: boolean) : Boolean; + + begin + if Peek then + NextToken; + Result:=CurToken = tkSquaredBraceOpen; + if Result then + begin + if not (msPrefixedAttributes in CurrentModeswitches) then + ParseExc(nParserExpectedConstVarID,SParserExpectedConstVarID); + ParseAttr(Peek); + end + else if Peek then + UnGettoken; + end; + var OldForceCaret,IsUntyped, LastHadDefaultValue: Boolean; Name : String; @@ -5092,6 +5131,8 @@ var Arg: TPasArgument; Access: TArgumentAccess; ArgType: TPasType; + HasAttr : Boolean; + begin LastHadDefaultValue := false; while True do @@ -5101,6 +5142,10 @@ begin IsUntyped := False; ArgType := nil; NextToken; + // [ref] (const|var|) a : type; + HasRef:=False; + HasAttr:=CheckAttributes(False); + if CurToken = tkDotDotDot then begin expectToken(endToken); @@ -5108,14 +5153,21 @@ begin end else if CurToken = tkConst then begin Access := argConst; + // (const|var|) [ref] a : type; + CheckAttributes(True); + if HasRef then + Access := argConstRef; Name := GetParamName; end else if CurToken = tkConstRef then begin Access := argConstref; + CheckAttributes(True); Name := getParamName; end else if CurToken = tkVar then begin Access := ArgVar; + // (const|var|) [ref] a : type; + CheckAttributes(True); Name:=GetParamName; end else if (CurToken = tkIdentifier) and (UpperCase(CurTokenString) = 'OUT') then begin diff --git a/packages/fcl-passrc/tests/tcclasstype.pas b/packages/fcl-passrc/tests/tcclasstype.pas index 21dda1da84..7c37efa8cf 100644 --- a/packages/fcl-passrc/tests/tcclasstype.pas +++ b/packages/fcl-passrc/tests/tcclasstype.pas @@ -82,6 +82,8 @@ type procedure TestOneSpecializedClassInterface; Procedure TestOneField; Procedure TestOneFieldComment; + procedure TestOneFieldWithAttribute; + procedure TestOneFieldVarWithAttribute; Procedure TestOneClassOfField; procedure TestOneFieldStatic; Procedure TestOneHelperField; @@ -592,7 +594,7 @@ begin ParseClass; end; -Procedure TTestClassType.TestForwardExternalObjCClass; +procedure TTestClassType.TestForwardExternalObjCClass; begin FStarted:=True; FEnded:=True; @@ -715,6 +717,26 @@ begin AssertVisibility; end; +procedure TTestClassType.TestOneFieldWithAttribute; +begin + Parser.CurrentModeswitches:=Parser.CurrentModeswitches+[msPrefixedAttributes]; + AddMember('[volatile] a : integer'); + ParseClass; + AssertEquals('Have 2 members',2,TheClass.Members.Count); + AssertMemberName('a',Members[1]); + AssertVisibility; +end; + +procedure TTestClassType.TestOneFieldVarWithAttribute; +begin + Parser.CurrentModeswitches:=Parser.CurrentModeswitches+[msPrefixedAttributes]; + AddMember('var [volatile] a : integer'); + ParseClass; + AssertEquals('Have 2 members',2,TheClass.Members.Count); + AssertMemberName('a',Members[1]); +end; + + procedure TTestClassType.TestOneFieldStatic; begin AddMember('a : integer; static'); @@ -2323,7 +2345,7 @@ begin AssertVisibility; end; -Procedure TTestClassType.TestExternalClassFunctionFinal; +procedure TTestClassType.TestExternalClassFunctionFinal; begin Parser.CurrentModeswitches:=[msObjfpc,msexternalClass]; diff --git a/packages/fcl-passrc/tests/tcprocfunc.pas b/packages/fcl-passrc/tests/tcprocfunc.pas index 2b0ba82688..b0fce6f284 100644 --- a/packages/fcl-passrc/tests/tcprocfunc.pas +++ b/packages/fcl-passrc/tests/tcprocfunc.pas @@ -69,6 +69,8 @@ type Procedure TestFunctionOneOutArg; procedure TestProcedureOneConstRefArg; Procedure TestFunctionOneConstRefArg; + procedure TestFunctionOneConstRefAttributeArg; + procedure TestFunctionOneConstRefAttributeArgReversed; procedure TestProcedureTwoArgs; Procedure TestFunctionTwoArgs; procedure TestProcedureTwoArgsSeparate; @@ -515,7 +517,7 @@ begin AssertArg(ProcType,0,'B',argDefault,'^Integer',''); end; -procedure TTestProcedureFunction.TestFunctionPointerResult; +procedure TTestProcedureFunction.TestFUnctionPointerResult; begin ParseFunction('()','^LongInt'); AssertFunc([],[],ccDefault,0); @@ -556,6 +558,24 @@ begin AssertArg(FuncType,0,'B',argConst,'Integer',''); end; + +procedure TTestProcedureFunction.TestFunctionOneConstRefAttributeArg; +begin + Parser.CurrentModeswitches:=Parser.CurrentModeswitches+[msPrefixedAttributes]; + ParseFunction('([ref] Const B : Integer)'); + AssertFunc([],[],ccDefault,1); + AssertArg(FuncType,0,'B',argConstRef,'Integer',''); +end; + +procedure TTestProcedureFunction.TestFunctionOneConstRefAttributeArgReversed; +begin + Parser.CurrentModeswitches:=Parser.CurrentModeswitches+[msPrefixedAttributes]; + ParseFunction('(Const [ref] B : Integer)'); + AssertFunc([],[],ccDefault,1); + AssertArg(FuncType,0,'B',argConstRef,'Integer',''); +end; + + procedure TTestProcedureFunction.TestProcedureOneOutArg; begin Parser.CurrentModeswitches:=[msObjfpc]; @@ -1491,7 +1511,7 @@ end; -Procedure TTestProcedureFunction.TestFunctionSyscallSingleNumber; +procedure TTestProcedureFunction.TestFunctionSyscallSingleNumber; begin // function Something : Someresult; syscall 12 AddDeclaration('function A : Integer; syscall 12'); @@ -1500,7 +1520,7 @@ begin end; -Procedure TTestProcedureFunction.TestFunctionSyscallDoubleNumber; +procedure TTestProcedureFunction.TestFunctionSyscallDoubleNumber; begin // function Something : Someresult; syscall 12 13 @@ -1510,7 +1530,7 @@ begin end; -Procedure TTestProcedureFunction.TestFunctionSysCallSysTrapIdentifier; +procedure TTestProcedureFunction.TestFunctionSysCallSysTrapIdentifier; begin // function Something : Someresult; syscall systrapNNN diff --git a/packages/fcl-passrc/tests/tcvarparser.pas b/packages/fcl-passrc/tests/tcvarparser.pas index 6f9652f0ea..55d7e06d48 100644 --- a/packages/fcl-passrc/tests/tcvarparser.pas +++ b/packages/fcl-passrc/tests/tcvarparser.pas @@ -64,6 +64,7 @@ Type Procedure TestVarPublicName; Procedure TestVarDeprecatedExternalName; Procedure TestVarHintPriorToInit; + Procedure TestVarAttribute; Procedure TestErrorRecovery; end; @@ -452,6 +453,22 @@ begin AssertEquals('Correct initialization value',False, E.Value); end; +procedure TTestVarParser.TestVarAttribute; +var + V : TPasVariable; +begin + + add('{$mode delphi}'); + Add('Var'); + Add(' [xyz] A : integer;'); + ParseDeclarations; + AssertEquals('One variable definition',1,Declarations.Variables.Count); + AssertEquals('First declaration is type definition.',TPasVariable,TObject(Declarations.Variables[0]).ClassType); + V:=TPasVariable(Declarations.Variables[0]); + AssertEquals('First declaration has correct name.','A',V.Name); + +end; + procedure TTestVarParser.TestErrorRecovery; begin diff --git a/packages/fcl-passrc/tests/testpassrc.lpi b/packages/fcl-passrc/tests/testpassrc.lpi index 7ffbc7f023..84fece9eec 100644 --- a/packages/fcl-passrc/tests/testpassrc.lpi +++ b/packages/fcl-passrc/tests/testpassrc.lpi @@ -27,13 +27,13 @@ - + - +