* objcprotocol can have multiple parents

git-svn-id: trunk@47480 -

packages/fcl-passrc/src/pparser.pp

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

packages/fcl-passrc/tests/tcclasstype.pas

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