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 ParseCType(Parser: TTextParser): TEntity;
function ParseNames(Parser: TTextParser; var NameType: TEntity; Names: TList; AllowMultipleNames: Boolean=True): 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): Boolean; function ParseName(Parser: TTextParser; var NameType: TEntity; var name: TNamePart; const EndChars: TCharSet): Boolean;
type type
@ -776,7 +776,7 @@ begin
end; end;
end; end;
if not Result then if not Result then begin
for i := 0 to TokenTable.CmtLine.Count - 1 do begin for i := 0 to TokenTable.CmtLine.Count - 1 do begin
Result:=IsSubStr(TokenTable.CmtLine[i], Buf, index); Result:=IsSubStr(TokenTable.CmtLine[i], Buf, index);
if Result then begin if Result then begin
@ -787,6 +787,7 @@ begin
Break; Break;
end; end;
end; end;
end;
if Result then begin if Result then begin
if UseCommentEntities then begin if UseCommentEntities then begin
@ -795,7 +796,7 @@ begin
comment.CommenType:=ct; comment.CommenType:=ct;
Comments.Add(Comment); Comments.Add(Comment);
end; end;
if (Assigned(OnComment)) and (cmt <> '') then OnComment(Self, cmt); if (Assigned(OnComment)) then OnComment(Self, cmt);
end; end;
end; end;
@ -1473,12 +1474,13 @@ var
begin begin
Result := nil; Result := nil;
s:=AParser.Token; s:=AParser.Token;
if s='' then Exit;
if s = 'typedef' then begin if s = 'typedef' then begin
Result:=ParseTypeDef(AParser); Result:=ParseTypeDef(AParser);
end else begin end else begin
v:=TVarFuncEntity.Create(AParser.TokenPos); v:=TVarFuncEntity.Create(AParser.TokenPos);
ParseNames(AParser, tp, v.Names); ParseNames(AParser, tp, v.Names, [';']);
// declarations like: // declarations like:
// fn (int i); // fn (int i);
@ -1511,6 +1513,7 @@ end;
procedure ErrorExpect(Parser:TTextParser;const Expect:AnsiString); procedure ErrorExpect(Parser:TTextParser;const Expect:AnsiString);
begin begin
Parser.SetError('expected: "'+ Expect + '" but "'+Parser.Token+'" found'); Parser.SetError('expected: "'+ Expect + '" but "'+Parser.Token+'" found');
Dump_Stack(output, get_frame);
end; end;
function ConsumeToken(Parser:TTextParser;const Token:AnsiString):Boolean; function ConsumeToken(Parser:TTextParser;const Token:AnsiString):Boolean;
@ -1640,7 +1643,7 @@ begin
Parser.NextToken; Parser.NextToken;
while Parser.Token<>')' do begin while Parser.Token<>')' do begin
if ParseName(Parser, prmtype, prmname) then begin if ParseName(Parser, prmtype, prmname, [',',')']) then begin
FuncName.AddParam(prmtype, prmname) FuncName.AddParam(prmtype, prmname)
end else end else
Exit; // failure Exit; // failure
@ -1723,12 +1726,12 @@ begin
end; end;
end; end;
function isEndOfName(APArser: TTextParser): Boolean; function isEndOfName(APArser: TTextParser; const EndChars: TCharSet): Boolean;
begin begin
Result:=(AParser.TokenType=tt_Symbol) and (AParser.Token[1] in [';',')',',']); Result:=(AParser.TokenType=tt_Symbol) and (AParser.Token[1] in EndChars);
end; 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 var
Name : TNamePart; Name : TNamePart;
done : Boolean; done : Boolean;
@ -1760,7 +1763,7 @@ begin
Result:=True; Result:=True;
Exit; Exit;
end; end;
done:=isEndOfName(Parser); done:=isEndOfName(Parser, EndChars);
if not done then begin if not done then begin
if Parser.Token <> ',' then begin if Parser.Token <> ',' then begin
ErrorExpect(Parser, ';'); ErrorExpect(Parser, ';');
@ -1773,7 +1776,7 @@ begin
end; end;
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 var
nm : TList; nm : TList;
begin begin
@ -1781,7 +1784,7 @@ begin
try try
name:=nil; name:=nil;
NameType:=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]); if Result and (nm.Count>0) then name:=TNamePart(nm[0]);
finally finally
nm.Free; nm.Free;
@ -1872,7 +1875,7 @@ begin
AParser.NextToken; AParser.NextToken;
repeat repeat
v:=TVarFuncEntity.Create(AParser.TokenPos); 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'); ErrorExpect(AParser, 'type name');
v.Free; v.Free;
Exit; Exit;
@ -1918,7 +1921,7 @@ begin
try try
repeat repeat
v:=TVarFuncEntity.Create(AParser.TokenPos); 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'); ErrorExpect(AParser, 'type name');
v.Free; v.Free;
Exit; Exit;
@ -1949,7 +1952,7 @@ begin
AParser.NextToken; AParser.NextToken;
Result:=td; Result:=td;
ParseNames(AParser, td.origintype, td.names, true); ParseNames(AParser, td.origintype, td.names, [';'], true);
finally finally
if not Assigned(Result) then if not Assigned(Result) then
td.Free; td.Free;
@ -1980,9 +1983,8 @@ begin
ErrorExpect(AParser, 'identifier'); ErrorExpect(AParser, 'identifier');
Exit; Exit;
end; end;
nm:=AParser.Token;
ofs:=AParser.TokenPos; ofs:=AParser.TokenPos;
AParser.NextToken; if not ConsumeIdentifier(AParser,nm) then Exit;
if AParser.Token='=' then begin if AParser.Token='=' then begin
AParser.NextToken; AParser.NextToken;
x:=ParseCExpr(AParser, True); x:=ParseCExpr(AParser, True);
@ -1992,7 +1994,7 @@ begin
en.AddItem(nm, x, ofs); en.AddItem(nm, x, ofs);
if AParser.Token=',' then AParser.NextToken; if AParser.Token=',' then AParser.NextToken;
end; end;
AParser.NextToken; if not ConsumeToken(AParser, '}') then Exit;
end; end;
Result:=en; Result:=en;
finally finally

58
components/chelper/ctopasconvert.pas
View File

@ -20,7 +20,6 @@ unit ctopasconvert;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
@ -174,6 +173,7 @@ type
procedure WriteObjCMethods(list: TList); procedure WriteObjCMethods(list: TList);
procedure WriteObjCInterface(cent: TObjCInterface); procedure WriteObjCInterface(cent: TObjCInterface);
procedure WriteObjCProtocol(cent: TObjCProtocol); procedure WriteObjCProtocol(cent: TObjCProtocol);
procedure WriteObjCClasses(cent: TObjCClasses);
procedure PushWriter; procedure PushWriter;
procedure PopWriter; procedure PopWriter;
@ -303,7 +303,6 @@ var
entidx : Integer; entidx : Integer;
begin begin
Result:=nil; Result:=nil;
ent := ParseNextEntity(AParser); ent := ParseNextEntity(AParser);
entidx := AParser.Index; entidx := AParser.Index;
@ -467,12 +466,11 @@ begin
p := CreateCParser(t); p := CreateCParser(t);
p.MacroHandler:=macros; p.MacroHandler:=macros;
p.UseCommentEntities := True; p.UseCommentEntities := True;
p.OnComment := @cmt.OnComment; p.OnComment:=@cmt.OnComment;
p.OnPrecompile:=@cmt.OnPrecompiler; p.OnPrecompile:=@cmt.OnPrecompiler;
try try
repeat repeat
cmt.Clear;
try try
ofs := p.Index; ofs := p.Index;
p.NextToken; p.NextToken;
@ -513,7 +511,7 @@ begin
for i:=0 to p.Comments.Count-1 do TComment(p.Comments[i]).Free; for i:=0 to p.Comments.Count-1 do TComment(p.Comments[i]).Free;
p.Comments.Clear; p.Comments.Clear;
cmt.Clear;
until (ent=nil) or not AllText; until (ent=nil) or not AllText;
@ -717,7 +715,7 @@ procedure TCodeConvertor.WriteObjCInterface(cent:TObjCInterface);
var var
i : Integer; i : Integer;
sc : TObjCScope; sc : TObjCScope;
v : TObjCInstVar; ivar : TObjCInstVar;
sect : AnsiString; sect : AnsiString;
const const
sectname : array [TObjCScope] of AnsiString = ('private', 'protected', 'public', 'protected'); sectname : array [TObjCScope] of AnsiString = ('private', 'protected', 'public', 'protected');
@ -733,23 +731,24 @@ begin
if cent.Protocols.Count>0 then begin if cent.Protocols.Count>0 then begin
if cent.SuperClass='' then wr.W('(id, ') if cent.SuperClass='' then wr.W('(id, ')
else wr.W(', '); else wr.W(', ');
for i:=0 to cent.Protocols.Count-2 do wr.W(cent.Protocols[i]+', '); for i:=0 to cent.Protocols.Count-2 do wr.W(cent.Protocols[i]+'Protocol, ');
wr.W(cent.Protocols[cent.Protocols.Count-1]); wr.W(cent.Protocols[cent.Protocols.Count-1]+'Protocol');
end; end;
if (cent.SuperClass<>'') or (cent.Protocols.Count>0) then wr.Wln(')'); if (cent.SuperClass<>'') or (cent.Protocols.Count>0) then wr.Wln(')');
sect:=''; sect:='';
sc:=os_Public; sc:=os_Public;
for i:=0 to cent.Vars.Count-1 do begin for i:=0 to cent.Vars.Count-1 do begin
v:=TObjCInstVar(cent.Vars[i]); ivar:=TObjCInstVar(cent.Vars[i]);
if (sect='') or (v.scope<>sc) then begin if (sect='') or (ivar.scope<>sc) then begin
if sect<>'' then wr.DecIdent; if sect<>'' then wr.DecIdent;
sc:=v.scope; sc:=ivar.scope;
sect:=sectname[sc]; sect:=sectname[sc];
wr.Wln(sect); wr.Wln(sect);
wr.IncIdent; wr.IncIdent;
end; end;
WriteFuncOrVar(v.v, false, true); WriteLnCommentsBeforeOffset(ivar.v.RetType.Offset);
WriteFuncOrVar(ivar.v, false, true);
end; end;
if sect<>'' then wr.DecIdent; if sect<>'' then wr.DecIdent;
end; end;
@ -768,26 +767,39 @@ var
i : Integer; i : Integer;
begin begin
SetPasSection(wr, 'type'); 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'); wr.W(cent.Names[0]+'Protocol = objcprotocol');
if cent.Protocols.Count>0 then begin if cent.Protocols.Count>0 then begin
wr.W('('); wr.W('(');
for i:=0 to cent.Protocols.Count-2 do wr.W(cent.Protocols[i]+', '); for i:=0 to cent.Protocols.Count-2 do wr.W(cent.Protocols[i]+'Protocol, ');
wr.W(cent.Protocols[cent.Protocols.Count-1]); wr.WLn(cent.Protocols[cent.Protocols.Count-1]+'Protocol)');
wr.Wln(')'); end else
wr.WLn;
if cent.Methods.Count>0 then begin
wr.IncIdent;
WriteObjCMethods(cent.Methods);
wr.DecIdent;
end; end;
wr.IncIdent;
WriteObjCMethods(cent.Methods);
wr.DecIdent;
wr.W('end; '); wr.W('end; ');
wr.Wln(' external name '''+cent.Names[0]+''';'); 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;
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; procedure TCodeConvertor.PushWriter;
begin begin
if not Assigned(fWriters) then fWriters:=TList.Create; if not Assigned(fWriters) then fWriters:=TList.Create;
@ -1131,6 +1143,8 @@ begin
WriteObjCInterface(cent as TObjCInterface) WriteObjCInterface(cent as TObjCInterface)
else if cent is TObjCProtocol then else if cent is TObjCProtocol then
WriteObjCProtocol(cent as TObjCProtocol) WriteObjCProtocol(cent as TObjCProtocol)
else if cent is TObjCClasses then
WriteObjCClasses(cent as TObjCClasses)
else begin else begin
if DebugEntities then if DebugEntities then
wr.Wln(cent.ClassName); wr.Wln(cent.ClassName);

34
components/chelper/objcparsing.pas
View File

@ -34,7 +34,7 @@ type
{ TObjCClasses } { TObjCClasses }
TObjCClasses = class(TEntity) TObjCClasses = class(TEntity)
Classes : TStringList; ClassList : TStringList;
constructor Create(AOffset: Integer=-1); override; constructor Create(AOffset: Integer=-1); override;
destructor Destroy; override; destructor Destroy; override;
end; end;
@ -156,7 +156,7 @@ begin
cl.Free; cl.Free;
Exit; Exit;
end; end;
cl.Classes.Add(AParser.Token); cl.ClassList.Add(AParser.Token);
AParser.NextToken; AParser.NextToken;
if AParser.Token=',' then if AParser.Token=',' then
AParser.NextToken AParser.NextToken
@ -201,7 +201,7 @@ begin
AParser.NextToken; AParser.NextToken;
end else begin end else begin
v:=TVarFuncEntity.Create(AParser.TokenPos); 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:=TObjCInstVar.Create(v.Offset);
iv.v:=v; iv.v:=v;
iv.scope:=scope; iv.scope:=scope;
@ -320,7 +320,8 @@ function ParseNextObjCEntity(AParser: TTextParser): TEntity;
var var
t : AnsiString; t : AnsiString;
begin begin
if AParser.Token[1]='@' then begin Result:=nil;
if (AParser.Token<>'') and (AParser.Token[1]='@') then begin
t:=GetObjCKeyword(AParser.Token); t:=GetObjCKeyword(AParser.Token);
if t='class' then Result:=ParseClassList(AParser) if t='class' then Result:=ParseClassList(AParser)
else if t='interface' then Result:=ParseInterface(AParser) else if t='interface' then Result:=ParseInterface(AParser)
@ -338,12 +339,12 @@ end;
constructor TObjCClasses.Create(AOffset:Integer); constructor TObjCClasses.Create(AOffset:Integer);
begin begin
inherited Create(AOffset); inherited Create(AOffset);
Classes := TStringList.Create; ClassList := TStringList.Create;
end; end;
destructor TObjCClasses.Destroy; destructor TObjCClasses.Destroy;
begin begin
Classes.Free; ClassList.Free;
inherited Destroy; inherited Destroy;
end; end;
@ -383,11 +384,12 @@ begin
m:=TObjCMethod.Create(AParser.TokenPos); m:=TObjCMethod.Create(AParser.TokenPos);
try try
m.isClassMethod:=AParser.Token='+';
AParser.NextToken; AParser.NextToken;
if AParser.Token='(' then begin if AParser.Token='(' then begin
AParser.NextToken; 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; if not ConsumeToken(AParser, ')') then Exit;
end; end;
@ -400,7 +402,7 @@ begin
while (AParser.Token<>';') and (AParser.Token<>',') do begin while (AParser.Token<>';') and (AParser.Token<>',') do begin
if AParser.Token='(' then begin if AParser.Token='(' then begin
prm:=ConsumeToken(AParser, '(') and prm:=ConsumeToken(AParser, '(') and
ParseName(APArser, atype, atname) and ParseName(APArser, atype, atname,[')']) and
ConsumeToken(AParser, ')'); ConsumeToken(AParser, ')');
end else begin end else begin
prm:=True; prm:=True;
@ -562,7 +564,12 @@ begin
s:=AParser.Token; s:=AParser.Token;
if (s='setter') or (s='getter') then begin if (s='setter') or (s='getter') then begin
AParser.NextToken; 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 if s='setter' then p.SetterName:=nm
else p.GetterName:=nm; else p.GetterName:=nm;
end else begin end else begin
@ -577,7 +584,7 @@ begin
ErrorExpect(AParser,')'); ErrorExpect(AParser,')');
Exit; Exit;
end; end;
if ParseName(AParser, p.RetType, p.Name) then begin if ParseName(AParser, p.RetType, p.Name,[';']) then begin
Result:=p; Result:=p;
if AParser.Token=';' then AParser.NextToken; if AParser.Token=';' then AParser.NextToken;
end; end;
@ -597,7 +604,12 @@ begin
if AParser.Token='<' then begin if AParser.Token='<' then begin
Result:=nil; Result:=nil;
AParser.NextToken; 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; end;
Result:=PrevNamePart(AParser); Result:=PrevNamePart(AParser);
end; end;