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

chelper: improve expression parsing detection of typecast vs (expression) - added standard set of c types and ctypeinfo library

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3997 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2015-03-06 04:32:31 +00:00
parent 7dc4fd2a7e
commit 1af6c4c6f1
2 changed files with 131 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

56
components/chelper/cparserexp.pas
View File

@ -8,7 +8,16 @@ uses
type
TIdentType = (itIdent, itIndex, itFuncCall, itField, itSubSel);
TExpDir = (edValue, edPrefix, edPostfix, edInfix, edTernary, edSequence);
TExpDir = ( // Expression Direction describes what relative fields should be initialzed
// for the expression node.
edValue // "none" - this should be a leaf of the expression graph
, edPrefix // "right"
, edPostfix // "left" for the host. "inner" is used for arrays and function calls
// "left" ( "inner" )
, edInfix // "left" and "right" are mandatory. used for all binary operators!
, edTernary // used for ? operator. "main", "left", "right" are used, "main" ? "left" : "right"
, edSequence // used for , operator (and parameters). "left" and "right" are used
);
TExp = class(TObject)
left : TExp;
@ -33,8 +42,36 @@ function ParseCExprEx(p: TTextParser): TExp;
function ValuateIntExp(exp: TExp; macros: TCMacroHandler): Integer; overload;
function ValuateIntExp(const exp: string; macros: TCMacroHandler): Integer; overload;
function isCTypeCast(exp: TExp; tinfo: TCTypeInfo): Boolean;
implementation
function isCTypeCast(exp: TExp; tinfo: TCTypeInfo): Boolean;
var
hasType: Boolean;
begin
Result:=false;
while Assigned(exp) do begin
if exp.dir = edPostfix then begin
exp:=exp.left;
end else if exp.dir = edPrefix then begin
exp:=exp.right;
end else if (exp.dir = edValue) then begin
if isStdCType(exp.val) then
hastype:=true
else begin
hasType:=Assigned(tinfo) and (tinfo.isType(exp.val));
if not hasType then Exit // an identify that's not a type
end;
exp:=nil;
end else begin
// nothing else os allowed in typecast
Exit;
end;
end;
Result:=hasType;
end;
function Rotate(core: TExp): TExp;
begin
if Assigned(core.right) and (core.right.dir<>edValue) and (core.right.pr>=core.pr) then
@ -86,10 +123,7 @@ begin
if it in [itField, itSubSel] then
exp.right:=level2(p, true)
else if it in [itFuncCall, itIndex] then begin
//writeln('parsing sub expression ', p.Token);
exp.inner:=ParseCExprEx(p);
//writeln('res = ', PtrUint(exp.inner));
//writeln('p.token =', p.Token);
if p.Token = CIdentClose[it] then
p.NextToken
else begin
@ -117,13 +151,19 @@ begin
// typecast
if (p.Tokentype=tt_Symbol) and (p.Token='(') then begin
p.NextToken;
ct:=TExp.Create(3, '(', edInfix);
ct.inner:=ParseCExprEx(p);
ct:=ParseCExprEx(p);
if (p.TokenType=tt_Symbol) and (p.Token = ')') then
p.NextToken;
ct.right:=ParseCExprEx(p);
if not isCTypeCast(ct, p.CTypeInfo) then begin
// not a typecast!
ct.pr:=1;
Result:=ct;
Result:=Rotate(Result);
end else begin
Result:=TExp.Create(3, 'typecast', edInfix);
Result.inner:=ct;
Result.right:=ParseCExprEx(p);
Result:=Rotate(REsult);
end;
end else if (p.Token='sizeof') or (p.Token='++') or (p.Token='--')
or ((length(p.Token) = 1) and (p.Token[1] in ['&','*','~','!','-','+']))
then begin

82
components/chelper/cparsertypes.pas
View File

@ -92,6 +92,18 @@ type
procedure Clear;
end;
{ TCTypeInfo }
TCTypeInfo = class(TObject)
private
ftypeNames : TStrings;
public
constructor Create;
destructor Destroy; override;
function isType(const nm: string): Boolean;
procedure RegisterTypeName(const nm: string);
end;
{ TTextParser }
TTextParser = class(TObject)
@ -122,6 +134,7 @@ type
Stack : TList;
Errors : TStringList;
MacroHandler : TCMacroHandler;
CTypeInfo : TCTypeInfo;
UseCommentEntities : Boolean;
UsePrecompileEntities : Boolean;
@ -140,6 +153,7 @@ type
function NextToken: Boolean;
function FindNextToken(var AToken: AnsiString; var ATokenType: TTokenType): Boolean;
function isTokenTypeName: Boolean;
procedure SetError(const ErrorCmt: AnsiString; const Context: string = '');
end;
@ -258,6 +272,7 @@ type
TCPPSectionClose = class(TCPPSection) // an entity for just closing character }
end;
const
nk_Ident = 0;
nk_Ref = 1;
@ -418,11 +433,46 @@ procedure DebugEnList(entlist: TList);
procedure ParseDefine(const s: string; def: TCPrepDefine);
function isStdCType(const s: string): boolean;
implementation
uses
cparserexp; // todo: expression parsing should in the same unit!
function isStdCType(const s: string): boolean;
begin
Result:=false;
if length(s)=0 then Exit;
case s[1] of
'c': Result:= s = 'char';
'd': Result:= s = 'double';
'f': Result:= s = 'float';
'i': Result:= s = 'int';
's': Result:= (s = 'short')
or (s = 'short int')
or (s = 'signed char')
or (s = 'signed short')
or (s = 'signed short int')
or (s = 'signed int')
or (s = 'signed long')
or (s = 'signed long long')
or (s = 'signed long long int');
'l': Result:= (s = 'long')
or (s = 'long int')
or (s = 'long long')
or (s = 'long double');
'u': Result:= (s = 'unsigned')
or (s = 'unsigned char')
or (s = 'unsigned short')
or (s = 'unsigned short int')
or (s = 'unsigned int')
or (s = 'unsigned long')
or (s = 'unsigned long long')
or (s = 'unsigned long long int');
end;
end;
procedure ParseDefine(const s: string; def: TCPrepDefine);
var
i : integer;
@ -931,6 +981,11 @@ begin
ATokenType:=TokenType;
end;
function TTextParser.isTokenTypeName: Boolean;
begin
Result:=Assigned(CTypeInfo) and (CTypeInfo.isType(Token));
end;
function TTextParser.SkipComments: Boolean;
var
i : Integer;
@ -2487,6 +2542,33 @@ begin
mh.AddParamMacro(def._Name, def.SubsText, def.Params);
end;
{ TCTypeInfo }
constructor TCTypeInfo.Create;
begin
inherited Create;
ftypeNames:=TStringList.Create;
TStringList(ftypeNames).Duplicates:=dupIgnore;
TStringList(ftypeNames).CaseSensitive:=true;
end;
destructor TCTypeInfo.Destroy;
begin
ftypeNames.Free;
inherited Destroy;
end;
function TCTypeInfo.isType(const nm: string): Boolean;
begin
Result:=ftypeNames.IndexOf(nm)>=0;
end;
procedure TCTypeInfo.RegisterTypeName(const nm: string);
begin
ftypeNames.Add(nm);
end;
initialization
_ParseNextEntity:=@ParseNextCEntity;
ParseNamePart:=@ParseCNamePart;