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

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

components/chelper/cparserexp.pas

@@ -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:=ParseCExprEx(p);
-      ct.inner:=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

components/chelper/cparsertypes.pas

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