Преглед изворни кода

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

git-svn-id: trunk@36709 -
michael пре 8 година
родитељ
комит
541128b086

+ 17 - 0
packages/fcl-passrc/src/pparser.pp

@@ -77,6 +77,7 @@ const
   nParserPropertyArgumentsCanNotHaveDefaultValues = 2050;
   nParserExpectedExternalClassName = 2051;
   nParserNoConstRangeAllowed = 2052;
+  nErrRecordVariablesNotAllowed = 2053;
 
 // resourcestring patterns of messages
 resourcestring
@@ -115,6 +116,7 @@ resourcestring
   SParserNoFieldsAllowed = 'Fields are not allowed in Interfaces';
   SParserInvalidRecordVisibility = 'Records can only have public and (strict) private as visibility specifiers';
   SErrRecordConstantsNotAllowed = 'Record constants not allowed at this location.';
+  SErrRecordVariablesNotAllowed = 'Record variables not allowed at this location.';
   SErrRecordMethodsNotAllowed = 'Record methods not allowed at this location.';
   SErrRecordPropertiesNotAllowed = 'Record properties not allowed at this location.';
   SErrRecordVisibilityNotAllowed = 'Record visibilities not allowed at this location.';
@@ -5449,6 +5451,21 @@ begin
         Cons.Visibility:=v;
         ARec.members.Add(Cons);
         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:
         begin
         if Not AllowMethods then

+ 16 - 0
packages/fcl-passrc/tests/tctypeparser.pas

@@ -270,6 +270,8 @@ type
     Procedure TestFieldAndProperty;
     Procedure TestFieldAndClassMethod;
     Procedure TestFieldAndClassOperator;
+    Procedure TestFieldAndClassVar;
+    Procedure TestFieldAndVar;
     Procedure TestNested;
     Procedure TestNestedDeprecated;
     Procedure TestNestedPlatform;
@@ -2053,6 +2055,20 @@ begin
   AssertEquals('Method 2 result type','Integer', P.FuncType.ResultEl.ResultType.Name);
 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;
 begin
   TestFields(['x : integer;','y : record','  z : integer;','end'],'',False);

+ 1 - 1
packages/fcl-passrc/tests/testpassrc.lpi

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