chelper: fix for objc methods, protocols parsing and writting

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1288 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/chelper/cparsertypes.pas

@@ -226,9 +226,69 @@ type
     _Params    : AnsiString;
   end;
 
-// parsing function
+type
+
+  { TSimpleType }
+
+  TSimpleType = class(TEntity)
+  public
+    Name : AnsiString;
+  end;
+
+  { TExpression }
+
+  TExpPart = record
+    Token     : AnsiString;
+    TokenType : TTokenType;
+  end;
+
+  TExpression = class(TEntity)
+    function DoParse(AParser: TTextParser): Boolean; override;
+  public
+    Tokens  : array of TExpPart;
+    Count   : Integer;
+    procedure PushToken(const AToken: AnsiString; ATokenType: TTokenType);
+  end;
+
+const
+  nk_Ident = 0;
+  nk_Ref   = 1;
+  nk_Array = 2;
+  nk_Func  = 3;
+
+type
+  TNameKind = Integer;
+
+type
+  TNamePart = class;
+
+  TFuncParam = record
+    prmtype : TEntity;
+    name    : TNamePart;
+  end;
+
+  { TNamePart }
+
+  TNamePart = class(TObject)
+  private
+    fChild  : TNamePart;
+    fOwner  : TNamePart;
+  public
+    Kind      : TNameKind;
+    RefCount  : Integer;
+    Id        : AnsiString;
+    arrayexp  : array of TExpression;
+    params    : array of TFuncParam;
+    constructor Create(AKind: TNameKind);
+    procedure AddParam(prmtype: TEntity; prmname: TNamePart);
+    procedure AddArrayExpr(expr: TExpression);
+    property child: TNamePart read fchild write fChild;    // int (*p)[10]; "[10]" is child of (*p)
+    property owner: TNamePart read fowner write fOwner;
+  end;
+
 var
   ParseNextEntity: function (AParser: TTextParser): TEntity = nil;
+  ParseNamePart : function (Parser: TTextParser): TNamePart = nil;
 
 function ParseNextCEntity(AParser: TTextParser): TEntity;
 
@@ -254,64 +314,12 @@ function CreateCParser(const CHeaderText: AnsiString;
 type
   TCustomEntityProc = function (Parent: TEntity; Parser: TTextParser): TEntity;
 
-type
-
-  { TSimpleType }
-
-  TSimpleType = class(TEntity)
-  public
-    Name : AnsiString;
-  end;
-
-  { TExpression }
-
-  TExpPart = record
-    Token     : AnsiString;
-    TokenType : TTokenType;
-  end;
-  TExpression = class(TEntity)
-    function DoParse(AParser: TTextParser): Boolean; override;
-  public
-    Tokens  : array of TExpPart;
-    Count   : Integer;
-    procedure PushToken(const AToken: AnsiString; ATokenType: TTokenType);
-  end;
-
 procedure ErrorExpect(Parser: TTextParser; const Expect: AnsiString);
 function ConsumeToken(Parser: TTextParser; const Token: AnsiString): Boolean;
 function ConsumeIdentifier(Parser: TTextParser; var Id: AnsiString): Boolean;
 
 function ParseCType(Parser: TTextParser): TEntity;
 
-type
-  TNamePart = class;
-
-  TFuncParam = record
-    prmtype : TEntity;
-    name    : TNamePart;
-  end;
-
-  TNameKind = (nk_Ident, nk_Ref, nk_Array, nk_Func);
-
-  { TNamePart }
-
-  TNamePart = class(TObject)
-  private
-    fChild  : TNamePart;
-    fOwner  : TNamePart;
-  public
-    Kind      : TNameKind;
-    RefCount  : Integer;
-    Id        : AnsiString;
-    arrayexp  : array of TExpression;
-    params    : array of TFuncParam;
-    constructor Create(AKind: TNameKind);
-    procedure AddParam(prmtype: TEntity; prmname: TNamePart);
-    procedure AddArrayExpr(expr: TExpression);
-    property child: TNamePart read fchild write fChild;    // int (*p)[10]; "[10]" is child of (*p)
-    property owner: TNamePart read fowner write fOwner;
-  end;
-
 function ParseNames(Parser: TTextParser; var NameType: TEntity; Names: TList; AllowMultipleNames: Boolean=True): Boolean;
 function ParseName(Parser: TTextParser; var NameType: TEntity; var name: TNamePart): Boolean;
 
@@ -1458,8 +1466,6 @@ end;
 function ParseNextCEntity(AParser: TTextParser): TEntity;
 var
   s   : AnsiString;
-  tt  : TTokenType;
-
   tp  : TEntity;
   nm  : TNamePart;
   v   : TVarFuncEntity;
@@ -1493,6 +1499,8 @@ begin
     end else
       Result:=v;
   end;
+
+  if AParser.Token<>';' then ErrorExpect(AParser,';');
 end;
 
 procedure ErrorExpect(Parser:TTextParser;const Expect:AnsiString);
@@ -1644,7 +1652,7 @@ begin
   Parser.NextToken;
 end;
 
-function ParseNamePart(Parser: TTextParser): TNamePart;
+function ParseCNamePart(Parser: TTextParser): TNamePart;
 var
   prefix    : TNamePart;
   id        : TNamePart;
@@ -2023,6 +2031,7 @@ end;
 
 initialization
   ParseNextEntity:=@ParseNextCEntity;
+  ParseNamePart:=@ParseCNamePart;
 
 
 end.

components/chelper/ctopasconvert.pas

@@ -81,6 +81,23 @@ function isNumberExp(x: TExpression; var v: Int64): Boolean;
 //        int a[MAXCONST] -> a: array [0..MAXCONST-1] of Integer;
 function PasArrayLimit(x: TExpression): AnsiString;
 
+type
+
+  { TStopComment }
+
+  TStopComment = class(TObject)
+  public
+    FirstComment  : boolean;
+    CommentFound  : boolean;
+    CommentEnd    : Integer;
+    Precomp       : TEntity;
+    PrecompEnd    : Integer;
+
+    procedure OnComment(Sender: TObject; const Str: ansistring);
+    procedure OnPrecompiler(Sender: TTextParser; PrecompEntity: TObject);
+    procedure Clear;
+  end;
+
 implementation
 
 type
@@ -114,7 +131,6 @@ type
     CmtList         : TList;
     Breaker         : TLineBreaker;
     LastOffset      : Integer;
-    function FindCommentForLine(ln: Integer): TComment;
   protected
     fWriters        : TList;
     AuxTypeCounter  : Integer;
@@ -140,7 +156,7 @@ type
     procedure WriteEnumAsConst(en: TEnumType; FinishWithInteger: Boolean=True);
     procedure WriteUnion(st: TUnionType);
     procedure WriteStruct(st: TStructType);
-    procedure WriteCommentToPas(cent: TComment);
+    procedure WriteCommentToPas(cent: TComment; NeedLineBreak: Boolean);
     procedure WriteExp(x: TExpression);
     procedure WritePreprocessor(cent: TCPrepDefine);
 
@@ -239,22 +255,8 @@ begin
 end;
 
 
-type
-
 { TStopComment }
 
-  TStopComment = class(TObject)
-  public
-    FirstComment  : boolean;
-    CommentFound  : boolean;
-    CommentEnd    : Integer;
-    Precomp       : TEntity;
-    PrecompEnd    : Integer;
-
-    procedure OnComment(Sender: TObject; const Str: ansistring);
-    procedure OnPrecompiler(Sender: TTextParser; PrecompEntity: TObject);
-  end;
-
 procedure TStopComment.OnComment(Sender: TObject; const Str: ansistring);
 var
   parser: TTextParser;
@@ -278,20 +280,22 @@ begin
   end;
 end;
 
-function ParseNextEntityOrComment(AParser: TTextParser): TEntity;
+procedure TStopComment.Clear;
+begin
+  FirstComment:=False;
+  CommentFound:=False;
+  Precomp:=nil;
+  CommentEnd:=-1;
+  PrecompEnd:=-1;
+end;
+
+function ParseNextEntityOrComment(AParser: TTextParser; cmt: TStopComment): TEntity;
 var
-  cmt : TStopComment;
   ent     : TEntity;
   entidx  : Integer;
 begin
-  cmt := TStopComment.Create;
-  AParser.UseCommentEntities := True;
-  AParser.OnComment := @cmt.OnComment;
-  AParser.OnPrecompile:=@cmt.OnPrecompiler;
   Result:=nil;
 
-  AParser.NextToken;
-
   ent := ParseNextEntity(AParser);
   entidx := AParser.Index;
 
@@ -306,11 +310,11 @@ begin
     end;
   end;
 
-  cmt.Free;
   if (not Assigned(Result)) or (Assigned(ent) and (ent.Offset<Result.Offset)) then begin
     Result:=ent;
     AParser.Index:=entidx;
-  end;
+  end else
+    AParser.NextToken;
 end;
 
 function GetRefAsterix(const AstCount: integer): ansistring;
@@ -343,7 +347,6 @@ begin
     Result:=PasExp(x) + '-1';
 end;
 
-
 procedure WriteArray(arr: TNamePart; wr: TCodeWriter);
 var
   i : Integer;
@@ -353,7 +356,6 @@ begin
   wr.W(' of ');
 end;
 
-
 type
   TMacrosMaker = class(TObject)
   public
@@ -436,6 +438,7 @@ var
   owncfg    : Boolean;
   lastsec   : AnsiString; // last code section
   ofs       : Integer;
+  cmt       : TStopComment;
 begin
   Result:='';
   ent:=nil;
@@ -447,13 +450,19 @@ begin
 
     if cfg.CustomDefines<>'' then PrepareMacros(cfg.CustomDefines, macros);
 
+    cmt := TStopComment.Create;
     p := CreateCParser(t);
     p.MacroHandler:=macros;
+    p.UseCommentEntities := True;
+    p.OnComment := @cmt.OnComment;
+    p.OnPrecompile:=@cmt.OnPrecompiler;
+
     try
       repeat
         try
           ofs := p.Index;
-          ent := ParseNextEntityOrComment(p);
+          p.NextToken;
+          ent := ParseNextEntityOrComment(p, cmt);
         except
           ent:=nil;
         end;
@@ -473,7 +482,7 @@ begin
               end;
             end;
 
-            cnv.WriteCtoPas(ent, p.Comments, t);
+            cnv.WriteCtoPas(ent, p.Comments, p.Buf);
 
             lastsec:=cnv.wr.Section;
           except
@@ -495,15 +504,14 @@ begin
       while i < p.Index do begin
         Inc(endPoint.Y);
         le := i;
-        SkipLine(t, i);
+        SkipLine(p.Buf, i);
       end;
       endPoint.X := p.Index - le + 1 + p.MacrosDelta;
 
-
-
     finally
       p.Free;
       macros.Free;
+      cmt.Free;
     end;
   except
     on e: Exception do Result:=Result+LineEnding+' internal error: '+ e.Message;
@@ -533,7 +541,7 @@ begin
   inherited Destroy;
 end;
 
-procedure TCodeConvertor.WriteCommentToPas(cent: TComment);
+procedure TCodeConvertor.WriteCommentToPas(cent: TComment; NeedLineBreak: Boolean);
 var
   u: ansistring;
 begin
@@ -541,12 +549,13 @@ begin
   if cent.CommenType = ctBlock then
   begin
     u := StringReplace(u, '*)', '* )', [rfReplaceAll]);
-    wr.Wln('(*' + u + ' *)');
+    wr.W('(*' + u + ' *)');
   end
   else
   begin
-    wr.Wln('//' + u);
+    wr.W('//' + u);
   end;
+  if NeedLineBreak then wr.Wln;
 end;
 
 procedure TCodeConvertor.WriteExp(x:TExpression);
@@ -625,6 +634,9 @@ begin
       if m.Args[i].Name=''
         then PNames[i]:=cfg.ParamPrefix+IntToStr(i)
         else PNames[i]:=m.Args[i].Name;
+      if not Assigned(m.Args[i].RetType) then
+        PTypes[i]:='id'
+      else
         PTypes[i]:=GetPasTypeName(m.Args[i].RetType, m.Args[i].TypeName);
     end;
 
@@ -662,7 +674,6 @@ begin
 
       wr.W('procedure '+nm+'(AValue: '+tp+'); message '''+mtd+''';');
     end;
-
   end;
 end;
 
@@ -675,14 +686,17 @@ begin
   for i:=0 to list.Count-1 do begin
     ent:=TEntity(list[i]);
     if not Assigned(ent) then Continue;
+
     WriteLnCommentsBeforeOffset(ent.Offset);
     if ent is TObjCMethod then
       WriteObjCMethod(TObjCMethod(ent))
     else if ent is TObjCProperty then begin
       WriteObjCProperty(TObjCProperty(ent));
     end;
+
     WriteLnCommentForOffset(ent.Offset);
   end;
+
 end;
 
 procedure TCodeConvertor.WriteObjCInterface(cent:TObjCInterface);
@@ -696,7 +710,9 @@ const
 begin
   SetPasSection(wr, 'type');
   if cent.isCategory then begin
-    wr.W(cent.Name + ' = objccategory')
+    wr.W(cent.Name + ' = objccategory');
+    if cent.SuperClass<>'' then wr.W('('+cent.SuperClass+')');
+    wr.Wln;
   end else begin
     wr.W(cent.Name + ' = objcclass');
     if cent.SuperClass<>'' then wr.W('('+cent.SuperClass);
@@ -730,7 +746,7 @@ begin
     WriteObjCMethods(cent.Methods);
     wr.DecIdent;
   end;
-  wr.Wln('end external;')
+  wr.Wln('end external;');
 end;
 
 procedure TCodeConvertor.WriteObjCProtocol(cent:TObjCProtocol);
@@ -738,7 +754,8 @@ var
   i : Integer;
 begin
   SetPasSection(wr, 'type');
-  wr.W(cent.Name+'Protocol = objcprotocol');
+  if cent.Names.Count=1 then begin
+    wr.W(cent.Names[0]+'Protocol = objcprotocol');
 
     if cent.Protocols.Count>0 then begin
       wr.W('(');
@@ -750,7 +767,11 @@ begin
     WriteObjCMethods(cent.Methods);
     wr.DecIdent;
     wr.W('end; ');
-  wr.Wln(' external name '''+cent.Name+''';');
+    wr.Wln(' external name '''+cent.Names[0]+''';');
+  end else begin
+    for i:=0 to cent.Names.Count-1 do
+      wr.Wln(cent.Names[i]+'Protocol = objcprotocol; external name '''+cent.Names[i]+''';');
+  end;
 end;
 
 procedure TCodeConvertor.PushWriter;
@@ -808,13 +829,24 @@ end;
 procedure TCodeConvertor.WriteLnCommentForOffset(AOffset:Integer; NeedOffset: Boolean);
 var
   cmt : TComment;
+  ln  : Integer;
+  c   : Integer;
+  i   : Integer;
 begin
-  cmt:=FindCommentForLine( Breaker.LineNumber(AOffset));
+  ln:= Breaker.LineNumber(AOffset);
-  if Assigned(cmt) then begin
+  c:=0;
+  for i:=0 to CmtList.Count-1 do begin
+    cmt:=TComment(CmtList[i]);
+    if Breaker.LineNumber(TComment(CmtList[i]).Offset)=ln then begin
+      if NeedOffset then begin
+        wr.W('  ');
+        NeedOffset:=False;
+      end;
+      WriteCommentToPas(cmt, false);
       LastOffset:=cmt.Offset;
-    if NeedOffset then wr.W('  ');
+      inc(c);
-    WriteCommentToPas(cmt);
+    end;
-  end else
+  end;
   wr.Wln;
 end;
 
@@ -1078,7 +1110,7 @@ begin
       wr.Wln(';');
     end;
   end else if cent is TComment then
-    WriteCommentToPas(cent as TComment)
+    WriteCommentToPas(cent as TComment, True)
   else if cent is TCPrepDefine then
     WritePreprocessor(cent as TCPrepDefine)
   else if cent is TObjCInterface then
@@ -1332,20 +1364,7 @@ begin
     wr.W(PasTypeName + ' = ');}
     wr.W('todo: '+TypeEntity.ClassName);
   end;
-  //todo: ...
+  //todo: ...parse any Entity
-end;
-
-function TCodeConvertor.FindCommentForLine(ln:Integer):TComment;
-var
-  i : Integer;
-begin
-  Result:=nil;
-  if not Assigned(CmtList) then Exit;
-  for i:=0 to CmtList.Count-1 do
-    if Breaker.LineNumber(TComment(CmtList[i]).Offset)=ln then begin
-      Result:=TComment(CmtList[i]);
-      Exit;
-    end;
 end;
 
 procedure TCodeConvertor.DefFuncWrite(wr:TCodeWriter;const FuncName,FuncRetType:AnsiString;

components/chelper/objcparsing.pas

@@ -26,6 +26,9 @@ interface
 uses
   Classes, SysUtils, cparsertypes;
 
+const
+  objcend = '@end';
+
 type
 
   { TObjCClasses }
@@ -54,6 +57,7 @@ type
     RetName   : TNamePart;
     Args      : array of TObjCMethodArg;
     Option    : TObjCMethodOpt;
+    VarParams : Boolean;
     constructor Create(AOffset: Integer=-1); override;
     destructor Destroy; override;
     procedure AddArg(const ArgType: TEntity; ArgTypeName: TNamePart; const Name: AnsiString);
@@ -88,7 +92,7 @@ type
 
   TObjCProtocol = class(TEntity)
   public
-    Name        : AnsiString;
+    Names       : TStringList;
     isForward   : Boolean;
     Protocols   : TStringList;
     Methods     : TList;
@@ -113,7 +117,7 @@ function ParseClassList(AParser: TTextParser): TObjCClasses;
 function ParseInterface(AParser: TTextParser): TObjCInterface;
 function ParseMethod(AParser: TTextParser): TObjCMethod;
 function ParseProperty(AParser: TTextParser): TObjCProperty;
-function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString): Boolean;
+function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString = objcend): Boolean;
 function ParseProtocol(AParser: TTextParser): TEntity;
 
 function ParseNextObjCEntity(AParser: TTextParser): TEntity;
@@ -121,6 +125,9 @@ function ParseNextObjCEntity(AParser: TTextParser): TEntity;
 function isObjCKeyword(const token: AnsiString): Boolean; inline;
 function GetObjCKeyword(const token: AnsiString): AnsiString;
 
+const
+  nk_Protocol = $1000;
+
 implementation
 
 function isObjCKeyword(const token: AnsiString): Boolean; inline;
@@ -140,6 +147,7 @@ var
 begin
   Result:=nil;
   if AParser.Token<>'@class' then Exit;
+  try
     cl:=TObjCClasses.Create(AParser.TokenPos);
     AParser.NextToken;
     while AParser.Token<>';' do begin
@@ -158,7 +166,11 @@ begin
         Exit;
       end;
     end;
+    if AParser.Token<>';' then ErrorExpect(AParser, ';');
     Result:=cl;
+  finally
+    if not Assigned(Result) then cl.Free;
+  end;
 end;
 
 function ParseInstVars(AParser: TTextParser; Vars: TList): Boolean;
@@ -217,14 +229,14 @@ begin
 
   itf:=TObjCInterface.Create(i);
   try
-    itf.Name:=nm;
     itf.isCategory:=AParser.Token='(';
     if itf.isCategory then begin
+      itf.SuperClass:=nm;
       AParser.NextToken;
-       if not ConsumeIdentifier(AParser, itf.SuperClass) and ConsumeToken(AParser, ')') then
+      if not (ConsumeIdentifier(AParser, itf.Name) and ConsumeToken(AParser, ')')) then
         Exit;
     end else begin
-
+      itf.Name:=nm;
       // super-class
       if AParser.Token=':' then begin
         AParser.NextToken;
@@ -249,8 +261,8 @@ begin
       ParseInstVars(AParser, itf.Vars);
     end;
 
-    if not ParseMethods(AParser, itf.Methods, '@end') then Exit;
+    if not ParseMethods(AParser, itf.Methods, objcend) then Exit;
-    if AParser.Token='@end' then AParser.NextToken;
+    if AParser.Token<>objcend then ErrorExpect(AParser, objcend);
 
     Result:=itf;
   finally
@@ -268,11 +280,17 @@ begin
   p := TObjCProtocol.Create(AParser.TokenPos);
   try
     AParser.NextToken;
-    if not ConsumeIdentifier(AParser, p.Name) then Exit;
+    if not ConsumeIdentifier(AParser, nm) then Exit;
-    p.isForward:= AParser.Token=';';
+    p.Names.Add(nm);
+    p.isForward:= (AParser.Token=';') or (AParser.Token=',');
     if p.isForward then begin
-      Result:=p;
+      while AParser.Token<>';' do begin
         AParser.NextToken;
+        ConsumeIdentifier(AParser, nm);
+        p.Names.Add(nm);
+      end;
+      Result:=p;
+      if AParser.Token<>';' then ErrorExpect(AParser, ';');
       Exit;
     end;
 
@@ -286,8 +304,8 @@ begin
       if AParser.Token='>' then AParser.NextToken;
     end;
 
-    if ParseMethods(AParser, p.Methods, '@end') then Result:=p;
+    if ParseMethods(AParser, p.Methods, objcend) then Result:=p;
-    if AParser.Token='@end' then AParser.NextToken;
+    if AParser.Token<>objcend then ErrorExpect(AParser, objcend);
   finally
     if not Assigned(Result) then p.Free;
   end;
@@ -295,6 +313,7 @@ end;
 
 var
   PrevParseNextEntity : function (AParser: TTextParser): TEntity = nil;
+  PrevNamePart : function (AParser: TTextParser): TNamePart = nil;
 
 function ParseNextObjCEntity(AParser: TTextParser): TEntity;
 var
@@ -377,25 +396,36 @@ begin
       m.Name.Add(nm+':');
       AParser.NextToken;
 
-      while AParser.Token<>';' do begin
+      while (AParser.Token<>';') and (AParser.Token<>',') do begin
+        if AParser.Token='(' then begin
           prm:=ConsumeToken(AParser, '(') and
                ParseName(APArser, atype, atname) and
-             ConsumeToken(AParser, ')') and
+               ConsumeToken(AParser, ')');
-             ConsumeIdentifier(AParser, aname);
+        end else begin
+          prm:=True;
+          atype:=nil;
+          atname:=nil;
+        end;
         if not prm then Exit;
+        ConsumeIdentifier(AParser, aname);
         m.AddArg(atype, atname, aname);
 
+        // the next name starts
         if AParser.TokenType=tt_Ident then ConsumeIdentifier(AParser, nm) else nm:='';
-        if AParser.Token<>';' then begin
+        if (AParser.Token<>';') and (AParser.Token<>',') then begin
           if not ConsumeToken(AParser,':') then Exit;
           m.Name.Add(nm+':');
         end;
       end;
-      AParser.NextToken;
+    end else
-    end else begin
       m.Name.Add(nm);
-      if not ConsumeToken(AParser, ';') then Exit;
+
+    if AParser.Token=',' then begin
+      AParser.NextToken;
+      if ConsumeToken(AParser,'...') then m.VarParams:=True
+      else ErrorExpect(AParser, '...');
     end;
+    if not ConsumeToken(AParser, ';') then Exit;
 
     Result:=m;
   finally
@@ -403,7 +433,7 @@ begin
   end;
 end;
 
-function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString = '@end'): Boolean;
+function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString): Boolean;
 var
   m   : TObjCMethod;
   p   : TObjCProperty;
@@ -484,6 +514,7 @@ begin
   inherited Create(AOffset);
   Protocols := TStringList.Create;
   Methods   := TList.Create;
+  Names     := TStringList.Create;
 end;
 
 destructor TObjCProtocol.Destroy;
@@ -493,6 +524,7 @@ begin
   for i:=0 to Methods.Count-1 do TObject(Methods[i]).Free;
   Methods.Free;
   Protocols.Free;
+  Names.Free;
   inherited Destroy;
 end;
 
@@ -521,7 +553,7 @@ begin
   Result:=nil;
   if AParser.Token<>'@property' then Exit;
   AParser.NextToken;
-  p := TObjCProperty.Create;
+  p := TObjCProperty.Create(AParser.TokenPos);
   try
     if AParser.Token='(' then begin
       AParser.NextToken;
@@ -556,9 +588,25 @@ begin
   end;
 end;
 
+function ParseObjCNamePart(AParser: TTextParser): TNamePart;
+var
+  p   : AnsiString;
+begin
+  // skipping protocol adopted type definition
+  if AParser.Token='<' then begin
+    Result:=nil;
+    AParser.NextToken;
+    if not (ConsumeIdentifier(AParser, p) and ConsumeToken(AParser,'>')) then Exit;
+  end;
+  Result:=PrevNamePart(AParser);
+end;
+
 initialization
   PrevParseNextEntity:=ParseNextEntity;
   ParseNextEntity:=ParseNextObjCEntity;
 
+  PrevNamePart:=ParseNamePart;
+  ParseNamePart:=ParseObjCNamePart;
+
 end.