paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-28 17:00:40 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix bug ID #32048: class variables (and variables) in record

Browse Source 
git-svn-id: trunk@36709 -
This commit is contained in:
michael 2017-07-09 14:17:09 +00:00
parent c9e15b9380
commit 541128b086
3 changed files with 34 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -77,6 +77,7 @@ const
nParserPropertyArgumentsCanNotHaveDefaultValues = 2050; nParserPropertyArgumentsCanNotHaveDefaultValues = 2050;
nParserExpectedExternalClassName = 2051; nParserExpectedExternalClassName = 2051;
nParserNoConstRangeAllowed = 2052; nParserNoConstRangeAllowed = 2052;
nErrRecordVariablesNotAllowed = 2053;
// resourcestring patterns of messages // resourcestring patterns of messages
resourcestring resourcestring
@ -115,6 +116,7 @@ resourcestring
SParserNoFieldsAllowed = 'Fields are not allowed in Interfaces'; SParserNoFieldsAllowed = 'Fields are not allowed in Interfaces';
SParserInvalidRecordVisibility = 'Records can only have public and (strict) private as visibility specifiers'; SParserInvalidRecordVisibility = 'Records can only have public and (strict) private as visibility specifiers';
SErrRecordConstantsNotAllowed = 'Record constants not allowed at this location.'; SErrRecordConstantsNotAllowed = 'Record constants not allowed at this location.';
SErrRecordVariablesNotAllowed = 'Record variables not allowed at this location.';
SErrRecordMethodsNotAllowed = 'Record methods not allowed at this location.'; SErrRecordMethodsNotAllowed = 'Record methods not allowed at this location.';
SErrRecordPropertiesNotAllowed = 'Record properties not allowed at this location.'; SErrRecordPropertiesNotAllowed = 'Record properties not allowed at this location.';
SErrRecordVisibilityNotAllowed = 'Record visibilities not allowed at this location.'; SErrRecordVisibilityNotAllowed = 'Record visibilities not allowed at this location.';
@ -5449,6 +5451,21 @@ begin
Cons.Visibility:=v; Cons.Visibility:=v;
ARec.members.Add(Cons); ARec.members.Add(Cons);
end; end;
tkVar:
begin
if Not AllowMethods then
ParseExc(nErrRecordVariablesNotAllowed,SErrRecordVariablesNotAllowed);
ExpectToken(tkIdentifier);
OldCount:=ARec.Members.Count;
ParseInlineVarDecl(ARec, ARec.Members, v, AEndToken=tkBraceClose);
for i:=OldCount to ARec.Members.Count-1 do
begin
if isClass then
With TPasVariable(ARec.Members[i]) do
VarModifiers:=VarModifiers + [vmClass];
Engine.FinishScope(stDeclaration,TPasVariable(ARec.Members[i]));
end;
end;
tkClass: tkClass:
begin begin
if Not AllowMethods then if Not AllowMethods then

16
packages/fcl-passrc/tests/tctypeparser.pas
View File

@ -270,6 +270,8 @@ type
Procedure TestFieldAndProperty; Procedure TestFieldAndProperty;
Procedure TestFieldAndClassMethod; Procedure TestFieldAndClassMethod;
Procedure TestFieldAndClassOperator; Procedure TestFieldAndClassOperator;
Procedure TestFieldAndClassVar;
Procedure TestFieldAndVar;
Procedure TestNested; Procedure TestNested;
Procedure TestNestedDeprecated; Procedure TestNestedDeprecated;
Procedure TestNestedPlatform; Procedure TestNestedPlatform;
@ -2053,6 +2055,20 @@ begin
AssertEquals('Method 2 result type','Integer', P.FuncType.ResultEl.ResultType.Name); AssertEquals('Method 2 result type','Integer', P.FuncType.ResultEl.ResultType.Name);
end; end;
procedure TTestRecordTypeParser.TestFieldAndClassVar;
begin
TestFields(['x : integer;','class var y : integer;'],'',False);
AssertField1([]);
AssertTrue('Second field is class var',vmClass in Field2.VarModifiers);
end;
procedure TTestRecordTypeParser.TestFieldAndVar;
begin
TestFields(['x : integer;','var y : integer;'],'',False);
AssertField1([]);
AssertTrue('Second field is regular var',not (vmClass in Field2.VarModifiers));
end;
procedure TTestRecordTypeParser.TestNested; procedure TTestRecordTypeParser.TestNested;
begin begin
TestFields(['x : integer;','y : record',' z : integer;','end'],'',False); TestFields(['x : integer;','y : record',' z : integer;','end'],'',False);

2
packages/fcl-passrc/tests/testpassrc.lpi
View File

@ -27,7 +27,7 @@
<RunParams> <RunParams>
<local> <local>
<FormatVersion Value="1"/> <FormatVersion Value="1"/>
<CommandLineParams Value="--suite=TTestProcedureFunction.TestOperatorTokens"/> <CommandLineParams Value="--suite=TTestRecordTypeParser.TestFieldAndClassVar"/>
</local> </local>
</RunParams> </RunParams>
<RequiredPackages Count="1"> <RequiredPackages Count="1">