paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-18 05:00:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* objcprotocol can have multiple parents

Browse Source 
git-svn-id: trunk@47480 -
This commit is contained in:
michael 2020-11-20 13:15:16 +00:00
parent 319c00b832
commit ebb1d78ced
2 changed files with 19 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -7434,7 +7434,7 @@ begin
CheckToken(tkend);
NextToken;
AType.AncestorType := ParseTypeReference(AType,false,Expr);
if AType.ObjKind in [okClass,okObjCClass] then
if AType.ObjKind in [okClass,okObjCClass,okObjcProtocol] then
while CurToken=tkComma do
begin
NextToken;
@ -7482,7 +7482,7 @@ begin
AExternalNameSpace:=CurTokenString;
if (aObjKind in [okObjcCategory,okObjcClass]) then
begin
// Name is optional in objcclass/category
// Name is optional in objcclass/category/protocol
NextToken;
if CurToken=tkBraceOpen then
exit;

17
packages/fcl-passrc/tests/tcclasstype.pas
View File

@ -171,6 +171,7 @@ type
procedure TestInterfaceEmpty;
procedure TestObjcProtocolEmpty;
procedure TestObjcProtocolEmptyExternal;
procedure TestObjcProtocolMultiParent;
procedure TestObjcProtocolOptional;
procedure TestObjcProtocolRequired;
procedure TestInterfaceDisp;
@ -1945,6 +1946,22 @@ begin
AssertNull('No UUID',TheClass.GUIDExpr);
end;
procedure TTestClassType.TestObjcProtocolMultiParent;
begin
StartInterface('A, B','',False,True,true);
FParent:='A';
EndClass();
ParseClass;
AssertEquals('Is interface',okObjcProtocol,TheClass.ObjKind);
AssertTrue('Is objectivec',TheClass.IsObjCClass);
AssertEquals('No members',0,TheClass.Members.Count);
AssertNull('No UUID',TheClass.GUIDExpr);
AssertEquals('Have 1 interface',1,TheClass.Interfaces.Count);
AssertNotNull('Correct class',TheClass.Interfaces[0]);
AssertEquals('Correct class',TPasUnresolvedTypeRef,TObject(TheClass.Interfaces[0]).ClassType);
AssertEquals('Interface name','B',TPasUnresolvedTypeRef(TheClass.Interfaces[0]).Name);
end;
procedure TTestClassType.TestObjcProtocolOptional;
begin
StartInterface('','',False,True);