瀏覽代碼

* Set visibility on record constants

git-svn-id: trunk@31259 -
michael 10 年之前
父節點
當前提交
6ba4413478
共有 2 個文件被更改,包括 26 次插入0 次删除
  1. 1 0
      packages/fcl-passrc/src/pparser.pp
  2. 25 0
      packages/fcl-passrc/tests/tctypeparser.pas

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

@@ -3821,6 +3821,7 @@ begin
           ParseExc(SErrRecordConstantsNotAllowed);
         ExpectToken(tkIdentifier);
         Cons:=ParseConstDecl(ARec);
+        Cons.Visibility:=v;
         ARec.members.Add(Cons);
         end;
       tkClass:

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

@@ -158,6 +158,7 @@ type
 
   TTestRecordTypeParser= Class(TBaseTestTypeParser)
   private
+    function GetC(AIndex: Integer): TPasConst;
     Function GetField(AIndex : Integer; R : TPasRecordType) : TPasVariable;
     Function GetField(AIndex : Integer; R : TPasVariant) : TPasVariable;
     function GetF(AIndex: Integer): TPasVariable;
@@ -167,6 +168,7 @@ type
   Protected
     Procedure TestFields(Const Fields : Array of string; AHint : String; HaveVariant : Boolean = False);
     procedure AssertVariantSelector(AName, AType: string);
+    procedure AssertConst1(Hints: TPasMemberHints);
     procedure AssertField1(Hints: TPasMemberHints);
     procedure AssertField2(Hints: TPasMemberHints);
     procedure AssertMethod2(Hints: TPasMemberHints; isClass : Boolean = False);
@@ -198,6 +200,7 @@ type
     procedure DoTestVariantNestedVariantSecondDeprecated(const AHint: string);
     procedure DoTestVariantNestedVariantBothDeprecated(const AHint: string);
     Property TheRecord : TPasRecordType Read GetR;
+    Property Const1 : TPasConst Index 0 Read GetC;
     Property Field1 : TPasVariable Index 0 Read GetF;
     Property Field2 : TPasVariable Index 1 Read GetF;
     Property Variant1 : TPasVariant Index 0 Read GetV;
@@ -220,6 +223,7 @@ type
     Procedure TestOnePlatformField;
     Procedure TestOnePlatformFieldDeprecated;
     Procedure TestOnePlatformFieldPlatform;
+    Procedure TestOneConstOneField;
     Procedure TestTwoFields;
     procedure TestTwoFieldProtected;
     procedure TestTwoFieldStrictPrivate;
@@ -1110,6 +1114,11 @@ end;
 
 { TTestRecordTypeParser }
 
+function TTestRecordTypeParser.GetC(AIndex: Integer): TPasConst;
+begin
+  Result:=TObject(GetR.Members[AIndex]) as TPasConst;
+end;
+
 function TTestRecordTypeParser.GetField(AIndex: Integer; R: TPasRecordType
   ): TPasVariable;
 begin
@@ -1201,6 +1210,13 @@ begin
   AssertEquals('Have variant selector type name',AType,TheRecord.VariantType.Name);
 end;
 
+procedure TTestRecordTypeParser.AssertConst1(Hints: TPasMemberHints);
+begin
+  AssertEquals('Member 1 type',TPasConst,TObject(TheRecord.Members[0]).ClassType);
+  AssertEquals('Const 1 name','x',Const1.Name);
+  AssertNotNull('Have 1 const expr',Const1.Expr);
+end;
+
 
 procedure TTestRecordTypeParser.DoTestEmpty(const AHint: String);
 begin
@@ -1707,6 +1723,15 @@ begin
   AssertOneIntegerField([hplatform]);
 end;
 
+procedure TTestRecordTypeParser.TestOneConstOneField;
+begin
+  Scanner.Options:=[po_Delphi];
+  TestFields(['public','Const x =123;','y : integer'],'',False);
+  AssertConst1([]);
+  AssertEquals('Correct visibility',visPublic,TPasConst(TheRecord.Members[0]).Visibility);
+  AssertField2([]);
+end;
+
 procedure TTestRecordTypeParser.TestTwoFields;
 begin
   TestFields(['x : integer;','y : integer'],'',False);