paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-23 13:58:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix redeclaration of property which is default

Browse Source 
git-svn-id: trunk@27132 -
This commit is contained in:
michael 2014-03-14 08:33:57 +00:00
parent 848e650189
commit e3cdbbe099
2 changed files with 77 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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
packages/fcl-passrc/tests/tcclasstype.pas
View File

@ -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);