* Fixed bug ID #25704 (visibility specifiers in records in Delphi mode)

git-svn-id: trunk@26749 -

packages/fcl-passrc/src/pparser.pp

@@ -62,6 +62,7 @@ resourcestring
   SParsingUsedUnit = 'Parsing used unit "%s" with commandLine "%s"';
   SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Record helpers';
   SParserNoFieldsAllowed = 'Fields are not allowed in Interfaces';
+  SParserInvalidRecordVisibility = 'Records can only have public and (strict) private as visibility specifiers';
 
 type
   TPasParserLogHandler = Procedure (Sender : TObject; Const Msg : String) of object;
@@ -3602,6 +3603,7 @@ Procedure TPasParser.ParseRecordFieldList(ARec : TPasRecordType; AEndToken : TTo
 
 Var
   VN : String;
+  v : TPasmemberVisibility;
 
 begin
   while CurToken<>AEndToken do
@@ -3609,7 +3611,17 @@ begin
     Case CurToken of
       tkIdentifier :
         begin
-        ParseInlineVarDecl(ARec, ARec.Members, visDefault, AEndToken=tkBraceClose);
+        v:=visDefault;
+        If po_delphi in Scanner.Options then
+          if CheckVisibility(CurtokenString,v) then
+            begin
+            if not (v in [visPrivate,visPublic,visStrictPrivate]) then
+              ParseExc(SParserInvalidRecordVisibility);
+            NextToken;
+            if CurToken<>tkIdentifier then
+              ParseExc(SParserTypeSyntaxError);
+            end;
+        ParseInlineVarDecl(ARec, ARec.Members, v, AEndToken=tkBraceClose);
         end;
       tkCase :
         begin

packages/fcl-passrc/tests/tctypeparser.pas

@@ -206,6 +206,10 @@ type
     Procedure TestOnePlatformFieldDeprecated;
     Procedure TestOnePlatformFieldPlatform;
     Procedure TestTwoFields;
+    procedure TestTwoFieldProtected;
+    procedure TestTwoFieldStrictPrivate;
+    procedure TestTwoFieldPrivateNoDelphi;
+    Procedure TestTwoFieldPrivate;
     Procedure TestTwoFieldDeprecated;
     Procedure TestTwoFieldPlatform;
     Procedure TestTwoFieldsFirstDeprecated;
@@ -1172,7 +1176,8 @@ begin
 end;
 
 
-procedure TTestRecordTypeParser.AssertVariant1(Hints: TPasMemberHints; VariantLabels : Array of string);
+procedure TTestRecordTypeParser.AssertVariant1(Hints: TPasMemberHints;
+  VariantLabels: array of string);
 
 Var
   I : Integer;
@@ -1212,7 +1217,8 @@ begin
   AssertVariant2(Hints,['1']);
 end;
 
-procedure TTestRecordTypeParser.AssertVariant2(Hints: TPasMemberHints; VariantLabels : Array of string);
+procedure TTestRecordTypeParser.AssertVariant2(Hints: TPasMemberHints;
+  VariantLabels: array of string);
 
 Var
   I : Integer;
@@ -1465,7 +1471,7 @@ begin
 end;
 
 procedure TTestRecordTypeParser.AssertRecordVariant(AIndex: Integer;
-  Hints: TPasMemberHints; VariantLabels : Array of string);
+  Hints: TPasMemberHints; VariantLabels: array of string);
 
 Var
   F : TPasVariant;
@@ -1497,8 +1503,9 @@ begin
 
 end;
 
-procedure TTestRecordTypeParser.AssertRecordVariantVariant(AIndex: Integer; Const AFieldName,ATypeName: string;
-  Hints: TPasMemberHints; VariantLabels: array of string);
+procedure TTestRecordTypeParser.AssertRecordVariantVariant(AIndex: Integer;
+  const AFieldName, ATypeName: string; Hints: TPasMemberHints;
+  VariantLabels: array of string);
 
 Var
   F : TPasVariant;
@@ -1617,6 +1624,50 @@ begin
   AssertTwoIntegerFields([],[]);
 end;
 
+procedure TTestRecordTypeParser.TestTwoFieldPrivateNoDelphi;
+Var
+  B : Boolean;
+begin
+  try
+    TestFields(['private','x : integer'],'',False);
+    Fail('Need poDelphi for visibility specifier')
+  except
+    on E : Exception do
+      B:=E is EParserError;
+  end;
+  If not B then
+    Fail('Wrong exception class.');
+end;
+
+procedure TTestRecordTypeParser.TestTwoFieldProtected;
+Var
+  B : Boolean;
+begin
+  try
+    TestFields(['protected','x : integer'],'',False);
+    Fail('Protected not allowed as record visibility specifier')
+  except
+    on E : Exception do
+      B:=E is EParserError;
+  end;
+  If not B then
+    Fail('Wrong exception class.');
+end;
+
+procedure TTestRecordTypeParser.TestTwoFieldPrivate;
+begin
+  Scanner.Options:=[po_Delphi];
+  TestFields(['private','x,y : integer'],'',False);
+  AssertTwoIntegerFields([],[]);
+end;
+
+procedure TTestRecordTypeParser.TestTwoFieldStrictPrivate;
+begin
+  Scanner.Options:=[po_Delphi];
+  TestFields(['strict private','x,y : integer'],'',False);
+  AssertTwoIntegerFields([],[]);
+end;
+
 procedure TTestRecordTypeParser.TestTwoFieldDeprecated;
 begin
   TestFields(['x : integer;','y : integer'],'deprecated',False);