pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

chelper: fix for error reporting, empty comments are now converted as well

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1292 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2010-08-18 07:08:08 +00:00
parent 90fda595b9
commit 9955c92eb0
3 changed files with 79 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files

38
components/chelper/cparsertypes.pas
View File

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

58
components/chelper/ctopasconvert.pas
View File

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

34
components/chelper/objcparsing.pas
View File

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