Browse Source

* Fix redeclaration of property which is default

git-svn-id: trunk@27132 -
michael 11 years ago
parent
commit
e3cdbbe099
2 changed files with 77 additions and 1 deletions
  1. 1 1
      packages/fcl-passrc/src/pparser.pp
  2. 76 0
      packages/fcl-passrc/tests/tcclasstype.pas

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

@@ -2993,7 +2993,7 @@ begin
       NextToken;
       NextToken;
     if CurTokenIsIdentifier('DEFAULT') then
     if CurTokenIsIdentifier('DEFAULT') then
       begin
       begin
-      if not isArray then
+      if (Result.VarType<>Nil) and (not isArray) then
         ParseExc('The default property must be an array property');
         ParseExc('The default property must be an array property');
       NextToken;
       NextToken;
       if CurToken = tkSemicolon then
       if CurToken = tkSemicolon then

+ 76 - 0
packages/fcl-passrc/tests/tcclasstype.pas

@@ -84,6 +84,10 @@ type
     procedure TestHintFieldUninmplemented;
     procedure TestHintFieldUninmplemented;
     Procedure TestMethodSimple;
     Procedure TestMethodSimple;
     Procedure TestClassMethodSimple;
     Procedure TestClassMethodSimple;
+    Procedure TestConstructor;
+    Procedure TestClassConstructor;
+    Procedure TestDestructor;
+    Procedure TestClassDestructor;
     Procedure TestFunctionMethodSimple;
     Procedure TestFunctionMethodSimple;
     Procedure TestClassFunctionMethodSimple;
     Procedure TestClassFunctionMethodSimple;
     Procedure TestMethodOneArg;
     Procedure TestMethodOneArg;
@@ -104,6 +108,7 @@ type
     Procedure Test2Methods;
     Procedure Test2Methods;
     Procedure Test2MethodsDifferentVisibility;
     Procedure Test2MethodsDifferentVisibility;
     Procedure TestPropertyRedeclare;
     Procedure TestPropertyRedeclare;
+    Procedure TestPropertyRedeclareDefault;
     Procedure TestPropertyReadOnly;
     Procedure TestPropertyReadOnly;
     Procedure TestPropertyReadWrite;
     Procedure TestPropertyReadWrite;
     Procedure TestPropertyWriteOnly;
     Procedure TestPropertyWriteOnly;
@@ -649,6 +654,62 @@ begin
   AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
   AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
 end;
 end;
 
 
+Procedure TTestClassType.TestConstructor;
+begin
+  AddMember('Constructor Create');
+  ParseClass;
+  AssertEquals('1 members',1,TheClass.members.Count);
+  AssertEquals('1 class procedure',TPasConstructor,members[0].ClassType);
+  AssertEquals('Default visibility',visDefault,Members[0].Visibility);
+  AssertMemberName('Create');
+  AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
+  AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
+  AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
+  AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
+end;
+
+Procedure TTestClassType.TestClassConstructor;
+begin
+  AddMember('Class Constructor Create');
+  ParseClass;
+  AssertEquals('1 members',1,TheClass.members.Count);
+  AssertEquals('1 class procedure',TPasClassConstructor,members[0].ClassType);
+  AssertEquals('Default visibility',visDefault,Members[0].Visibility);
+  AssertMemberName('Create');
+  AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
+  AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
+  AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
+  AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
+end;
+
+Procedure TTestClassType.TestDestructor;
+begin
+  AddMember('Destructor Destroy');
+  ParseClass;
+  AssertEquals('1 members',1,TheClass.members.Count);
+  AssertEquals('1 class procedure',TPasDestructor,members[0].ClassType);
+  AssertEquals('Default visibility',visDefault,Members[0].Visibility);
+  AssertMemberName('Destroy');
+  AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
+  AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
+  AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
+  AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
+end;
+
+Procedure TTestClassType.TestClassDestructor;
+begin
+  AddMember('Class Destructor Destroy');
+  ParseClass;
+  AssertEquals('1 members',1,TheClass.members.Count);
+  AssertEquals('1 class procedure',TPasClassDestructor,members[0].ClassType);
+  AssertEquals('Default visibility',visDefault,Members[0].Visibility);
+  AssertMemberName('Destroy');
+  AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
+  AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
+  AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
+  AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
+end;
+
 Procedure TTestClassType.TestFunctionMethodSimple;
 Procedure TTestClassType.TestFunctionMethodSimple;
 begin
 begin
   AddMember('Function DoSomething : integer');
   AddMember('Function DoSomething : integer');
@@ -906,6 +967,21 @@ begin
   Assertequals('No default value','',Property1.DefaultValue);
   Assertequals('No default value','',Property1.DefaultValue);
 end;
 end;
 
 
+Procedure TTestClassType.TestPropertyRedeclareDefault;
+begin
+  StartVisibility(visPublic);
+  AddMember('Property Something; default;');
+  ParseClass;
+  AssertProperty(Property1,visPublic,'Something','','','','',0,True,False);
+  AssertNull('No type',Property1.VarType);
+  Assertequals('No index','',Property1.IndexValue);
+  AssertNull('No Index expression',Property1.IndexExpr);
+  AssertNull('No Default expression',Property1.DefaultExpr);
+  Assertequals('No default value','',Property1.DefaultValue);
+  // Actually, already tested in AssertProperty
+  AssertEquals('Is default property',True, Property1.IsDefault);
+end;
+
 Procedure TTestClassType.TestPropertyReadOnly;
 Procedure TTestClassType.TestPropertyReadOnly;
 begin
 begin
   StartVisibility(visPublished);
   StartVisibility(visPublished);