From 9955c92eb0eec7ff0b79fd5b413e7d39e6f1be25 Mon Sep 17 00:00:00 2001 From: skalogryz Date: Wed, 18 Aug 2010 07:08:08 +0000 Subject: [PATCH] chelper: fix for error reporting, empty comments are now converted as well git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1292 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/chelper/cparsertypes.pas | 38 +++++++++--------- components/chelper/ctopasconvert.pas | 58 +++++++++++++++++----------- components/chelper/objcparsing.pas | 34 ++++++++++------ 3 files changed, 79 insertions(+), 51 deletions(-) diff --git a/components/chelper/cparsertypes.pas b/components/chelper/cparsertypes.pas index 8fb055f2d..381c0eaab 100755 --- a/components/chelper/cparsertypes.pas +++ b/components/chelper/cparsertypes.pas @@ -321,8 +321,8 @@ function ConsumeIdentifier(Parser: TTextParser; var Id: AnsiString): Boolean; function ParseCType(Parser: TTextParser): TEntity; -function ParseNames(Parser: TTextParser; var NameType: TEntity; Names: TList; AllowMultipleNames: Boolean=True): Boolean; -function ParseName(Parser: TTextParser; var NameType: TEntity; var name: TNamePart): Boolean; +function ParseNames(Parser: TTextParser; var NameType: TEntity; Names: TList; const EndChars: TCharSet; AllowMultipleNames: Boolean=True): Boolean; +function ParseName(Parser: TTextParser; var NameType: TEntity; var name: TNamePart; const EndChars: TCharSet): Boolean; type @@ -776,7 +776,7 @@ begin end; end; - if not Result then + if not Result then begin for i := 0 to TokenTable.CmtLine.Count - 1 do begin Result:=IsSubStr(TokenTable.CmtLine[i], Buf, index); if Result then begin @@ -787,6 +787,7 @@ begin Break; end; end; + end; if Result then begin if UseCommentEntities then begin @@ -795,7 +796,7 @@ begin comment.CommenType:=ct; Comments.Add(Comment); end; - if (Assigned(OnComment)) and (cmt <> '') then OnComment(Self, cmt); + if (Assigned(OnComment)) then OnComment(Self, cmt); end; end; @@ -1473,12 +1474,13 @@ var begin Result := nil; s:=AParser.Token; + if s='' then Exit; if s = 'typedef' then begin Result:=ParseTypeDef(AParser); end else begin v:=TVarFuncEntity.Create(AParser.TokenPos); - ParseNames(AParser, tp, v.Names); + ParseNames(AParser, tp, v.Names, [';']); // declarations like: // fn (int i); @@ -1511,6 +1513,7 @@ end; procedure ErrorExpect(Parser:TTextParser;const Expect:AnsiString); begin Parser.SetError('expected: "'+ Expect + '" but "'+Parser.Token+'" found'); + Dump_Stack(output, get_frame); end; function ConsumeToken(Parser:TTextParser;const Token:AnsiString):Boolean; @@ -1640,7 +1643,7 @@ begin Parser.NextToken; while Parser.Token<>')' do begin - if ParseName(Parser, prmtype, prmname) then begin + if ParseName(Parser, prmtype, prmname, [',',')']) then begin FuncName.AddParam(prmtype, prmname) end else Exit; // failure @@ -1723,12 +1726,12 @@ begin end; end; -function isEndOfName(APArser: TTextParser): Boolean; +function isEndOfName(APArser: TTextParser; const EndChars: TCharSet): Boolean; begin - Result:=(AParser.TokenType=tt_Symbol) and (AParser.Token[1] in [';',')',',']); + Result:=(AParser.TokenType=tt_Symbol) and (AParser.Token[1] in EndChars); end; -function ParseNames(Parser: TTextParser; var NameType: TEntity; Names: TList; AllowMultipleNames: Boolean): Boolean; +function ParseNames(Parser: TTextParser; var NameType: TEntity; Names: TList; const EndChars: TCharSet; AllowMultipleNames: Boolean): Boolean; var Name : TNamePart; done : Boolean; @@ -1760,7 +1763,7 @@ begin Result:=True; Exit; end; - done:=isEndOfName(Parser); + done:=isEndOfName(Parser, EndChars); if not done then begin if Parser.Token <> ',' then begin ErrorExpect(Parser, ';'); @@ -1773,7 +1776,7 @@ begin end; end; -function ParseName(Parser: TTextParser; var NameType: TEntity; var name: TNamePart): Boolean; +function ParseName(Parser: TTextParser; var NameType: TEntity; var name: TNamePart; const EndChars: TCharSet): Boolean; var nm : TList; begin @@ -1781,7 +1784,7 @@ begin try name:=nil; NameType:=nil; - Result:=ParseNames(Parser, NameType, nm, False); + Result:=ParseNames(Parser, NameType, nm, EndChars, False); if Result and (nm.Count>0) then name:=TNamePart(nm[0]); finally nm.Free; @@ -1872,7 +1875,7 @@ begin AParser.NextToken; repeat v:=TVarFuncEntity.Create(AParser.TokenPos); - if not ParseNames(AParser, v.RetType, v.Names) then begin + if not ParseNames(AParser, v.RetType, v.Names,[';',':']) then begin ErrorExpect(AParser, 'type name'); v.Free; Exit; @@ -1918,7 +1921,7 @@ begin try repeat v:=TVarFuncEntity.Create(AParser.TokenPos); - if not ParseNames(AParser, v.RetType, v.Names) then begin + if not ParseNames(AParser, v.RetType, v.Names,[';']) then begin ErrorExpect(AParser, 'type name'); v.Free; Exit; @@ -1949,7 +1952,7 @@ begin AParser.NextToken; Result:=td; - ParseNames(AParser, td.origintype, td.names, true); + ParseNames(AParser, td.origintype, td.names, [';'], true); finally if not Assigned(Result) then td.Free; @@ -1980,9 +1983,8 @@ begin ErrorExpect(AParser, 'identifier'); Exit; end; - nm:=AParser.Token; ofs:=AParser.TokenPos; - AParser.NextToken; + if not ConsumeIdentifier(AParser,nm) then Exit; if AParser.Token='=' then begin AParser.NextToken; x:=ParseCExpr(AParser, True); @@ -1992,7 +1994,7 @@ begin en.AddItem(nm, x, ofs); if AParser.Token=',' then AParser.NextToken; end; - AParser.NextToken; + if not ConsumeToken(AParser, '}') then Exit; end; Result:=en; finally diff --git a/components/chelper/ctopasconvert.pas b/components/chelper/ctopasconvert.pas index 32d680034..1a74e963d 100644 --- a/components/chelper/ctopasconvert.pas +++ b/components/chelper/ctopasconvert.pas @@ -20,7 +20,6 @@ unit ctopasconvert; {$mode objfpc}{$H+} - interface uses @@ -174,6 +173,7 @@ type procedure WriteObjCMethods(list: TList); procedure WriteObjCInterface(cent: TObjCInterface); procedure WriteObjCProtocol(cent: TObjCProtocol); + procedure WriteObjCClasses(cent: TObjCClasses); procedure PushWriter; procedure PopWriter; @@ -303,7 +303,6 @@ var entidx : Integer; begin Result:=nil; - ent := ParseNextEntity(AParser); entidx := AParser.Index; @@ -467,12 +466,11 @@ begin p := CreateCParser(t); p.MacroHandler:=macros; p.UseCommentEntities := True; - p.OnComment := @cmt.OnComment; + p.OnComment:=@cmt.OnComment; p.OnPrecompile:=@cmt.OnPrecompiler; try repeat - cmt.Clear; try ofs := p.Index; p.NextToken; @@ -513,7 +511,7 @@ begin for i:=0 to p.Comments.Count-1 do TComment(p.Comments[i]).Free; p.Comments.Clear; - + cmt.Clear; until (ent=nil) or not AllText; @@ -717,7 +715,7 @@ procedure TCodeConvertor.WriteObjCInterface(cent:TObjCInterface); var i : Integer; sc : TObjCScope; - v : TObjCInstVar; + ivar : TObjCInstVar; sect : AnsiString; const sectname : array [TObjCScope] of AnsiString = ('private', 'protected', 'public', 'protected'); @@ -733,23 +731,24 @@ begin if cent.Protocols.Count>0 then begin if cent.SuperClass='' then wr.W('(id, ') else wr.W(', '); - for i:=0 to cent.Protocols.Count-2 do wr.W(cent.Protocols[i]+', '); - wr.W(cent.Protocols[cent.Protocols.Count-1]); + for i:=0 to cent.Protocols.Count-2 do wr.W(cent.Protocols[i]+'Protocol, '); + wr.W(cent.Protocols[cent.Protocols.Count-1]+'Protocol'); end; if (cent.SuperClass<>'') or (cent.Protocols.Count>0) then wr.Wln(')'); sect:=''; sc:=os_Public; for i:=0 to cent.Vars.Count-1 do begin - v:=TObjCInstVar(cent.Vars[i]); - if (sect='') or (v.scope<>sc) then begin + ivar:=TObjCInstVar(cent.Vars[i]); + if (sect='') or (ivar.scope<>sc) then begin if sect<>'' then wr.DecIdent; - sc:=v.scope; + sc:=ivar.scope; sect:=sectname[sc]; wr.Wln(sect); wr.IncIdent; end; - WriteFuncOrVar(v.v, false, true); + WriteLnCommentsBeforeOffset(ivar.v.RetType.Offset); + WriteFuncOrVar(ivar.v, false, true); end; if sect<>'' then wr.DecIdent; end; @@ -768,26 +767,39 @@ var i : Integer; begin SetPasSection(wr, 'type'); - if cent.Names.Count=1 then begin + + if cent.isForward then begin + for i:=0 to cent.Names.Count-1 do + wr.Wln(cent.Names[i]+'Protocol = objcprotocol; external name '''+cent.Names[i]+''';'); + end else begin wr.W(cent.Names[0]+'Protocol = objcprotocol'); if cent.Protocols.Count>0 then begin wr.W('('); - for i:=0 to cent.Protocols.Count-2 do wr.W(cent.Protocols[i]+', '); - wr.W(cent.Protocols[cent.Protocols.Count-1]); - wr.Wln(')'); + for i:=0 to cent.Protocols.Count-2 do wr.W(cent.Protocols[i]+'Protocol, '); + wr.WLn(cent.Protocols[cent.Protocols.Count-1]+'Protocol)'); + end else + wr.WLn; + + if cent.Methods.Count>0 then begin + wr.IncIdent; + WriteObjCMethods(cent.Methods); + wr.DecIdent; end; - wr.IncIdent; - WriteObjCMethods(cent.Methods); - wr.DecIdent; wr.W('end; '); 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.WriteObjCClasses(cent:TObjCClasses); +var + i : Integer; +begin + SetPasSection(wr, 'type'); + for i:=0 to cent.ClassList.Count-1 do + wr.WLn(cent.ClassList[i] +' = objcclass; external;'); +end; + procedure TCodeConvertor.PushWriter; begin if not Assigned(fWriters) then fWriters:=TList.Create; @@ -1131,6 +1143,8 @@ begin WriteObjCInterface(cent as TObjCInterface) else if cent is TObjCProtocol then WriteObjCProtocol(cent as TObjCProtocol) + else if cent is TObjCClasses then + WriteObjCClasses(cent as TObjCClasses) else begin if DebugEntities then wr.Wln(cent.ClassName); diff --git a/components/chelper/objcparsing.pas b/components/chelper/objcparsing.pas index da0e758fb..25dfbac51 100644 --- a/components/chelper/objcparsing.pas +++ b/components/chelper/objcparsing.pas @@ -34,7 +34,7 @@ type { TObjCClasses } TObjCClasses = class(TEntity) - Classes : TStringList; + ClassList : TStringList; constructor Create(AOffset: Integer=-1); override; destructor Destroy; override; end; @@ -156,7 +156,7 @@ begin cl.Free; Exit; end; - cl.Classes.Add(AParser.Token); + cl.ClassList.Add(AParser.Token); AParser.NextToken; if AParser.Token=',' then AParser.NextToken @@ -201,7 +201,7 @@ begin AParser.NextToken; end else begin v:=TVarFuncEntity.Create(AParser.TokenPos); - if not ParseNames(AParser, v.RetType, v.Names) then Exit; + if not ParseNames(AParser, v.RetType, v.Names, [';']) then Exit; iv:=TObjCInstVar.Create(v.Offset); iv.v:=v; iv.scope:=scope; @@ -320,7 +320,8 @@ function ParseNextObjCEntity(AParser: TTextParser): TEntity; var t : AnsiString; begin - if AParser.Token[1]='@' then begin + Result:=nil; + if (AParser.Token<>'') and (AParser.Token[1]='@') then begin t:=GetObjCKeyword(AParser.Token); if t='class' then Result:=ParseClassList(AParser) else if t='interface' then Result:=ParseInterface(AParser) @@ -338,12 +339,12 @@ end; constructor TObjCClasses.Create(AOffset:Integer); begin inherited Create(AOffset); - Classes := TStringList.Create; + ClassList := TStringList.Create; end; destructor TObjCClasses.Destroy; begin - Classes.Free; + ClassList.Free; inherited Destroy; end; @@ -383,11 +384,12 @@ begin m:=TObjCMethod.Create(AParser.TokenPos); try + m.isClassMethod:=AParser.Token='+'; AParser.NextToken; if AParser.Token='(' then begin AParser.NextToken; - if not ParseName(AParser, m.RetType, m.RetName) then Exit; + if not ParseName(AParser, m.RetType, m.RetName,[')']) then Exit; if not ConsumeToken(AParser, ')') then Exit; end; @@ -400,7 +402,7 @@ begin while (AParser.Token<>';') and (AParser.Token<>',') do begin if AParser.Token='(' then begin prm:=ConsumeToken(AParser, '(') and - ParseName(APArser, atype, atname) and + ParseName(APArser, atype, atname,[')']) and ConsumeToken(AParser, ')'); end else begin prm:=True; @@ -562,7 +564,12 @@ begin s:=AParser.Token; if (s='setter') or (s='getter') then begin AParser.NextToken; - if not ConsumeToken(AParser, '=') and not ConsumeIdentifier(AParser, nm) then Exit; + if not ConsumeToken(AParser, '=') then Exit; + if not ConsumeIdentifier(AParser, nm) then Exit; + while (AParser.TokenType=tt_Ident) or (APArser.Token=':') do begin + nm:=nm+AParser.Token; + AParser.NextToken; + end; if s='setter' then p.SetterName:=nm else p.GetterName:=nm; end else begin @@ -577,7 +584,7 @@ begin ErrorExpect(AParser,')'); Exit; end; - if ParseName(AParser, p.RetType, p.Name) then begin + if ParseName(AParser, p.RetType, p.Name,[';']) then begin Result:=p; if AParser.Token=';' then AParser.NextToken; end; @@ -597,7 +604,12 @@ begin if AParser.Token='<' then begin Result:=nil; AParser.NextToken; - if not (ConsumeIdentifier(AParser, p) and ConsumeToken(AParser,'>')) then Exit; + repeat + if not ConsumeIdentifier(AParser, p) then Exit; + if AParser.Token=',' then AParser.NextToken; + until AParser.Token='>'; + + if not ConsumeToken(AParser,'>') then Exit; end; Result:=PrevNamePart(AParser); end;