chelper: revising c preprocess handling. added new routines to prepare and collection preprocessing information

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

components/chelper/cparsertypes.pas

@@ -62,8 +62,9 @@ type
   end;
 
   TTextParser = class;
+  TEntity = class;
 
-  TPrecompilerEvent = procedure (Sender: TTextParser; PrecompEntity: TObject) of object;
+  TPrecompilerEvent = procedure (Sender: TTextParser; PrecompEntity: TEntity) of object;
 
   TCMacroStruct = class(TObject)
     MacroName   : AnsiString;
@@ -95,13 +96,14 @@ type
 
   TTextParser = class(TObject)
   protected
-    ProcessingMacro : Boolean;
     function HandlePrecomiler: Boolean; virtual;
     function HandleMacro(var MacroStr: AnsiString; var ReplaceStr: AnsiString): Boolean;
 
     function IsMultiLine: Boolean;
     procedure SkipSingleEoLnChars;
   public
+    ProcessingMacro : Boolean;
+
     Buf           : AnsiString;
 
     Token         : AnsiString;
@@ -412,8 +414,106 @@ function ParseUnion(AParser: TTextParser): TUnionType;
 function ParseTypeDef(AParser: TTextParser): TTypeDef;
 function ParseEnum(AParser: TTextParser): TEnumType;
 
+function PreprocGlobal(const buf: string; fs: TFileOffsets; ent: TList): string;
+
 implementation
 
+{function FindNextPreproc(const s: string; var i: integer;
+  var PreType: TPreprocType; var Name, Content: string): Boolean;
+var
+  j : integer;
+begin
+  Result:=false;
+  while i<=length(S) do begin
+    ScanTo(s, i, EoLnChars+['#','/']);
+    Result:=(i<=length(s));
+    if not Result then Exit;
+    if s[i] in EoLnChars then begin
+      ScanWhile(s, i, EoLnChars);
+    end else if s[i]='#' then begin // a directive?
+      j:=i;
+      ScanBackWhile(s, j, WhiteSpaceChars);
+      if (j=0) or (s[j] in EoLnChars) then begin
+        // directive!
+        inc(i);
+        ScanWhile(s, i, WhiteSpaceChars);
+        Name:='#'+ScanTo(s, i, EoLnChars+WhiteSpaceChars);
+        PreType:=ppDirective;
+      end else
+        inc(i);
+    end;
+  end;
+end;}
+
+
+function PreprocGlobal(const buf: string; fs: TFileOffsets; ent: TList): string;
+var
+  i : integer;
+  j : integer;
+  k : integer;
+  cmt : TComment;
+  t   : integer;
+
+  procedure Feed(ToIdx: Integer);
+  begin
+    if (ToIdx>=k) then begin
+      Result:=Result+Copy(buf, k, toIdx-k);
+      ToIdx:=k+1;
+    end;
+  end;
+
+  procedure SetFeedOfs(ToIdx: integer);
+  begin
+    k:=ToIdx;
+  end;
+
+  procedure FeedChar(ch: AnsiChar = #32);
+  begin
+    Result:=Result+ch;
+  end;
+
+begin
+  i:=1;
+  k:=1;
+  Result:='';
+  while (i<=length(buf)) do begin
+    if (buf[i]='\') and (i<length(buf)) and (buf[i+1] in [#10,#13]) then begin
+      Feed(i);
+      if (i+2<=length(buf)) and (buf[i+2] in [#10,#13]) and (buf[i+1]<>buf[i+2]) then begin
+        t:=3;
+      end else
+        t:=2;
+      if Assigned(fs) then fs.AddOffset(i, -t); // decreasing delta
+      inc(i, t);
+      SetFeedOfs(i);
+    end else if (buf[i]='/') and (i<length(buf)) and (buf[i+1] in ['*','/']) then begin
+      Feed(i);
+      j:=i;
+      inc(i,2);
+      if buf[i-1]='*' then begin
+        while (i<length(buf)) and (buf[i]<>'*') and (buf[i+1]<>'/') do inc(i);
+        if buf[i+1]='/' then // well formed comment
+          inc(i,2)
+        else
+          i:=length(buf)+1;
+      end else
+         ScanTo(buf, i, EoLnChars);
+
+      if Assigned(ent) then begin
+        cmt := TComment.Create(i);
+        cmt.EndOffset:=i;
+        cmt._Comment:=Copy(buf, j, i-j);
+      end;
+
+      if Assigned(fs) then fs.AddOffset(i, j-i-1); // decreasing delta
+      FeedChar;
+      SetFeedOfs(i);
+    end else
+      inc(I);
+  end;
+  Feed(i);
+end;
+
 function SkipEndOfLineChars(const Src: AnsiString; idx: integer): Integer;
 begin
   if idx < length(Src) then begin

components/chelper/ctopasconvert.pas

@@ -105,17 +105,21 @@ type
     PrecompEnd    : Integer;
 
     procedure OnComment(Sender: TObject; const Str: ansistring);
-    procedure OnPrecompiler(Sender: TTextParser; PrecompEntity: TObject);
+    procedure OnPrecompiler(Sender: TTextParser; PrecompEntity: TEntity);
     procedure Clear;
   end;
 
 
+  { TMacrosMaker }
+
   TMacrosMaker = class(TObject)
   public
-    hnd : TCMacroHandler;
+    hnd          : TCMacroHandler;
-    allowRedfine: Boolean;
+    allowRedfine : Boolean;   // default true
+    ifCondProc   : Boolean;   // default false
     constructor Create(AHandler: TCMacroHandler);
-    procedure Precompiler(Sender: TTextParser; PrecompEntity: TObject);
+    procedure Precompiler(AParser: TTextParser; PrecompEntity: TEntity);
+    procedure HandleIfCond(AParser: TTextParser; IfEntity: TEntity);
   end;
 
 type
@@ -161,8 +165,15 @@ procedure AssignIntComments(SortedEnlist: TList);
 procedure DebugEnList(entlist: TList);
 procedure DebugHeaders(files: TStrings);
 
+function PreprocDirectives(const buf: string; macro: TMacrosMaker; fs: TFileOffsets; ent: TList): string;
+
 implementation
 
+function PreprocDirectives(const buf: string; macro: TMacrosMaker; fs: TFileOffsets; ent: TList): string;
+begin
+  Result:=buf;
+end;
+
 type
   TFuncWriterProc = procedure (wr: TCodeWriter; const FunctName, FuncRetName: AnsiString;
     const Params, ParamTypes: array of AnsiString) of object;
@@ -336,7 +347,7 @@ begin
   CommentFound := True;
 end;
 
-procedure TStopComment.OnPrecompiler(Sender: TTextParser; PrecompEntity: TObject);
+procedure TStopComment.OnPrecompiler(Sender: TTextParser; PrecompEntity: TEntity);
 begin
   if not FirstComment and (PrecompEntity is TEntity) then
   begin
@@ -434,11 +445,16 @@ begin
   hnd:=AHandler;
 end;
 
-procedure TMacrosMaker.Precompiler(Sender: TTextParser; PrecompEntity: TObject);
+procedure TMacrosMaker.Precompiler(AParser: TTextParser; PrecompEntity: TEntity);
 var
   d : TCPrepDefine;
 begin
-  if not (PrecompEntity is TCPrepDefine) then Exit;
+  //writelN('precompiler: ', PrecompEntity.ClassName);
+  if (ifCondProc) and (PrecompEntity is TCPrepIf) then begin
+    HandleIfCond(AParser, PrecompEntity);
+    Exit;
+  end else if not (PrecompEntity is TCPrepDefine) then
+    Exit;
 
   d:=TCPrepDefine(PrecompEntity);
 
@@ -451,6 +467,75 @@ begin
   end;
 end;
 
+procedure SkipPreproc(AParser: TTextParser);
+var
+  cnd : integer;
+  i   : Integer;
+begin
+  // skipping  until the end of line
+  i:=AParser.Index;
+  ScanTo(AParser.Buf, i, EoLnChars);
+  ScanWhile(AParser.Buf, i, EoLnChars);
+  // scan until preproc, comment line or end of line
+  ScanWhile(AParser.Buf, i, WhiteSpaceChars);
+  if i>length(AParser.Buf) then Exit;
+
+  if AParser.Buf[i] = '#' then begin
+    // precompiler!
+
+  end else begin
+    if (AParser.Buf[i]='/') and (AParser.Buf[i+1]='/') then begin
+      // skipping until the end of line
+      ScanTo(AParser.Buf, i, EoLnChars);
+    end else if (AParser.Buf[i]='/') and (AParser.Buf[i+1]='*') then begin
+      // skip until then close of '*
+    end;
+  end;
+end;
+
+procedure TMacrosMaker.HandleIfCond(AParser: TTextParser; IfEntity: TEntity);
+var
+  op   : string;
+  cond : string;
+  isCondMet : Boolean;
+  cnt       : integer;
+begin
+  writeln('if cond! ', IfEntity.ClassName);
+  op:='';
+  cond:='';
+  if IfEntity is TCPrepIf then begin
+    op := trim(TCPrepIf(IfEntity).IfOp);
+    cond := trim(TCPrepIf(IfEntity)._Cond);
+  end;
+
+  if ((op='ifndef') or (op = 'ifdef')) then begin
+    isCondMet := hnd.isMacroDefined(cond);
+    if (op='ifndef') then isCondMet:=not isCondMet;
+  end else begin
+    isCondMet := false;
+  end;
+
+  writeln('if op = "',op,'"');
+  writeln('cond  = "',cond,'"');
+  writeln('result = ', isCondMet);
+  writeln('processing macro: ', Aparser.ProcessingMacro);
+  exit;
+
+  cnt:=0;
+  if not isCondMet then begin
+    // let's skip! until the "end" or "else" or "elif"
+
+    AParser.OnPrecompile:=nil; //hack: this must not be HERE!
+    while AParser.Token<>'' do begin
+      AParser.NextToken;
+    end;
+
+    AParser.OnPrecompile:=Self.Precompiler; //hack: this must not be HERE!
+  end;
+
+  AParser.NextToken;
+end;
+
 procedure PrepareMacros(const t: AnsiString; hnd: TCMacroHandler);
 var
   p : TTextParser;
@@ -509,6 +594,7 @@ begin
   //inp.stopcmt:=TStopComment.Create;
 
   inp.mmaker := TMacrosMaker.Create(p.MacroHandler);
+  inp.mmaker.ifCondProc:=true;
   inp.mmaker.allowRedfine:=false; // todo: it should be true!
   p.OnPrecompile:=inp.mmaker.Precompiler;
 

components/chelper/textparsingutils.pas

@@ -39,7 +39,9 @@ const
   AlphaNumChars  = AlphabetChars+NumericChars;
 
 function ScanWhile(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
+function ScanBackWhile(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
 function ScanTo(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
+function ScanBackTo(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
 function SkipToEoln(const s: AnsiString; var index: Integer): AnsiString;
 
 // returns #10, #13, #10#13 or #13#10, if s[index] is end-of-line sequence
@@ -84,6 +86,22 @@ type
     property Count: Integer read GetCount;
   end;
 
+type
+  TFileOfsInfo = record
+    origOfs : Integer; // original 1-based index in the file
+    delta   : Integer; // the new delta that should be used starting this file
+  end;
+
+  { TFileOffsets }
+
+  TFileOffsets = class(TObject)
+  public
+    Ofs   : array of TFileOfsInfo;
+    Count : Integer;
+    procedure AddOffset(origOfs, delta: integer);
+    function OrigOffset(tempOfs: integer): Integer;
+  end;
+
 implementation
 
 function ScanWhile(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
@@ -103,6 +121,28 @@ begin
   index := length(s) + 1;
 end;
 
+function ScanBackWhile(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
+var
+  j : integer;
+begin
+  Result:='';
+  if (index <= 0) or (index > length(s)) then Exit;
+  j:=index;
+  while (index>0) and (s[index] in ch) do dec(index);
+  Result:=Copy(s, index+1, j-index);
+end;
+
+function ScanBackTo(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
+var
+ j : integer;
+begin
+  Result:='';
+  if (index <= 0) or (index > length(s)) then Exit;
+  j:=index;
+  while (index>0) and not (s[index] in ch) do dec(index);
+  Result:=Copy(s, index+1, j-index);
+end;
+
 function ScanTo(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString;
 var
   i : Integer;
@@ -230,5 +270,29 @@ begin
   Tag:=ATag;
 end;
 
+procedure TFileOffsets.AddOffset(origOfs, delta: integer);
+begin
+  if Count=length(Ofs) then begin
+    if Count=0 then SetLength(Ofs, 4)
+    else SetLength(Ofs, Count*2);
+  end;
+  Ofs[Count].origOfs:=origOfs;
+  Ofs[Count].delta:=delta;
+  inc(Count);
+end;
+
+function TFileOffsets.OrigOffset(tempOfs: integer): Integer;
+var
+  i : Integer;
+begin
+  Result:=tempOfs;
+  for i:=0 to Count-1 do begin
+    if (Ofs[i].origOfs <= tempOfs) then
+      inc(Result, Ofs[i].delta);
+  end;
+end;
+
+
+
 end.