* Added logging options

git-svn-id: trunk@19752 -

packages/fcl-passrc/src/pparser.pp

@@ -51,8 +51,21 @@ resourcestring
   SParserExpectedIdentifier = 'Identifier expected';
   SParserNotAProcToken = 'Not a procedure or function token';
 
+  SLogStartImplementation = 'Start parsing implementation section.';
+  SLogStartInterface = 'Start parsing interface section';
+
 type
+  TPasParserLogHandler = Procedure (Sender : TObject; Const Msg : String) of object;
+  TPParserLogEvent = (pleInterface,pleImplementation);
+  TPParserLogEvents = set of TPParserLogEvent;
+
+  { TPasTreeContainer }
+
   TPasTreeContainer = class
+  private
+    FOnLog: TPasParserLogHandler;
+    FPParserLogEvents: TPParserLogEvents;
+    FScannerLogEvents: TPScannerLogEvents;
   protected
     FPackage: TPasPackage;
     FInterfaceOnly : Boolean;
@@ -71,6 +84,9 @@ type
     function FindModule(const AName: String): TPasModule; virtual;
     property Package: TPasPackage read FPackage;
     property InterfaceOnly : Boolean Read FInterfaceOnly Write FInterFaceOnly;
+    Property ScannerLogEvents : TPScannerLogEvents Read FScannerLogEvents Write FScannerLogEvents;
+    Property ParserLogEvents : TPParserLogEvents Read FPParserLogEvents Write FPParserLogEvents;
+    Property OnLog : TPasParserLogHandler Read FOnLog Write FOnLog;
   end;
 
   EParserError = class(Exception)
@@ -97,6 +113,8 @@ type
   private
     FCurModule: TPasModule;
     FFileResolver: TFileResolver;
+    FLogEvents: TPParserLogEvents;
+    FOnLog: TPasParserLogHandler;
     FOptions: TPOptions;
     FScanner: TPascalScanner;
     FEngine: TPasTreeContainer;
@@ -113,6 +131,9 @@ type
     function GetVariableValueAndLocation(Parent : TPasElement; out Value, Location: String): Boolean;
     procedure ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibility: TPasMemberVisibility; Full: Boolean);
   protected
+    function LogEvent(E : TPParserLogEvent) : Boolean; inline;
+    Procedure DoLog(Const Msg : String; SkipSourceInfo : Boolean = False);overload;
+    Procedure DoLog(Const Fmt : String; Args : Array of const;SkipSourceInfo : Boolean = False);overload;
     function GetProcTypeFromToken(tk: TToken; IsClass: Boolean=False ): TProcType;
     procedure ParseRecordFieldList(ARec: TPasRecordType; AEndToken: TToken);
     procedure ParseRecordVariantParts(ARec: TPasRecordType; AEndToken: TToken);
@@ -205,6 +226,8 @@ type
     property CurTokenString: String read FCurTokenString;
     Property Options : TPOptions Read FOptions Write FOptions;
     Property CurModule : TPasModule Read FCurModule;
+    Property LogEvents : TPParserLogEvents Read FLogEvents Write FLogEvents;
+    Property OnLog : TPasParserLogHandler Read FOnLog Write FOnLog;
   end;
 
 function ParseSource(AEngine: TPasTreeContainer;
@@ -352,6 +375,8 @@ begin
     Scanner := TPascalScanner.Create(FileResolver);
     Scanner.Defines.Append('FPK');
     Scanner.Defines.Append('FPC');
+    SCanner.LogEvents:=AEngine.ScannerLogEvents;
+    SCanner.OnLog:=AEngine.Onlog;
 
     // TargetOS
     s := UpperCase(OSTarget);
@@ -387,6 +412,8 @@ begin
 
     Parser := TPasParser.Create(Scanner, FileResolver, AEngine);
     Filename := '';
+    Parser.LogEvents:=AEngine.ParserLogEvents;
+    Parser.OnLog:=AEngine.Onlog;
 
     if FPCCommandLine<>'' then
       begin
@@ -1570,6 +1597,8 @@ begin
     CheckHint(Module,True);
 //    ExpectToken(tkSemicolon);
     ExpectToken(tkInterface);
+    If LogEvent(pleInterface) then
+      DoLog(SLogStartInterface );
     ParseInterface;
   finally
     FCurModule:=nil;
@@ -1725,7 +1754,11 @@ begin
         if (CurToken = tkImplementation) and (Declarations is TInterfaceSection) then
           begin
           If Not Engine.InterfaceOnly then
+            begin
+            If LogEvent(pleImplementation) then
+              DoLog(SLogStartImplementation);
             ParseImplementation;
+            end;
           break;
           end;
       tkinitialization:
@@ -2186,6 +2219,26 @@ begin
   end;
 end;
 
+function TPasParser.LogEvent(E: TPParserLogEvent): Boolean;
+begin
+  Result:=E in FLogEvents;
+end;
+
+procedure TPasParser.DoLog(const Msg: String; SkipSourceInfo: Boolean);
+begin
+  If Assigned(FOnLog) then
+    if SkipSourceInfo or not assigned(scanner) then
+      FOnLog(Self,Msg)
+    else
+      FOnLog(Self,Format('%s(%d) : %s',[Scanner.CurFilename,SCanner.CurRow,Msg]));
+end;
+
+procedure TPasParser.DoLog(const Fmt: String; Args: array of const;
+  SkipSourceInfo: Boolean);
+begin
+  DoLog(Format(Fmt,Args),SkipSourceInfo);
+end;
+
 procedure TPasParser.ParseInlineVarDecl(Parent: TPasElement; List: TFPList;
   AVisibility: TPasMemberVisibility = VisDefault; ClosingBrace: Boolean = False);
 

packages/fcl-passrc/src/pscanner.pp

@@ -30,6 +30,14 @@ resourcestring
   SErrIfXXXNestingLimitReached = 'Nesting of $IFxxx too deep';
   SErrInvalidPPElse = '$ELSE without matching $IFxxx';
   SErrInvalidPPEndif = '$ENDIF without matching $IFxxx';
+  SLogOpeningFile = 'Opening source file "%s".';
+  SLogLineNumber = 'Reading line %d.';
+  SLogIFDefAccepted = 'IFDEF %s found, accepting.';
+  SLogIFDefRejected = 'IFDEF %s found, rejecting.';
+  SLogIFNDefAccepted = 'IFNDEF %s found, accepting.';
+  SLogIFNDefRejected = 'IFNDEF %s found, rejecting.';
+  SLogIFOPTIgnored = 'IFOPT %s found, ignoring (rejected).';
+  SLogIFIgnored = 'IF %s found, ignoring (rejected).';
 
 type
 
@@ -194,6 +202,10 @@ type
 
   { TPascalScanner }
 
+  TPScannerLogHandler = Procedure (Sender : TObject; Const Msg : String) of object;
+  TPScannerLogEvent = (sleFile,sleLineNumber,sleConditionals);
+  TPScannerLogEvents = Set of TPScannerLogEvent;
+
   TPascalScanner = class
   private
     FFileResolver: TFileResolver;
@@ -204,6 +216,8 @@ type
     FCurTokenString: string;
     FCurLine: string;
     FDefines: TStrings;
+    FLogEvents: TPScannerLogEvents;
+    FOnLog: TPScannerLogHandler;
     TokenStr: PChar;
     FIncludeStack: TList;
 
@@ -216,10 +230,13 @@ type
 
     function GetCurColumn: Integer;
   protected
+    Procedure DoLog(Const Msg : String; SkipSourceInfo : Boolean = False);overload;
+    Procedure DoLog(Const Fmt : String; Args : Array of const;SkipSourceInfo : Boolean = False);overload;
     procedure Error(const Msg: string);overload;
     procedure Error(const Msg: string; Args: array of Const);overload;
     function DoFetchTextToken: TToken;
     function DoFetchToken: TToken;
+    function LogEvent(E : TPScannerLogEvent) : Boolean; inline;
   public
     Options : TPOptions;
     constructor Create(AFileResolver: TFileResolver);
@@ -239,6 +256,8 @@ type
     property CurTokenString: string read FCurTokenString;
 
     property Defines: TStrings read FDefines;
+    Property LogEvents : TPScannerLogEvents Read FLogEvents Write FLogEvents;
+    Property OnLog : TPScannerLogHandler Read FOnLog Write FOnLog;
   end;
 
 const
@@ -542,6 +561,8 @@ end;
 procedure TPascalScanner.OpenFile(const AFilename: string);
 begin
   FCurSourceFile := FileResolver.FindSourceFile(AFilename);
+  if LogEvent(sleFile) then
+    DoLog(SLogOpeningFile,[AFileName],True);
   FCurFilename := AFilename;
   FileResolver.BaseDirectory := IncludeTrailingPathDelimiter(ExtractFilePath(AFilename));
 end;
@@ -664,6 +685,8 @@ function TPascalScanner.DoFetchToken: TToken;
       TokenStr := PChar(CurLine);
       Result := true;
       Inc(FCurRow);
+      if LogEvent(sleLineNumber) and ((FCurRow Mod 100) = 0) then
+        DoLog(SLogLineNumber,[FCurRow],True);
     end;
   end;
 
@@ -1040,6 +1063,8 @@ begin
                 FCurFilename := Param;
                 if FCurSourceFile is TFileLineReader then
                   FCurFilename := TFileLineReader(FCurSourceFile).Filename; // nicer error messages
+                If LogEvent(sleFile) then
+                  DoLog(SLogOpeningFile,[FCurFileName],True);
                 FCurRow := 0;
               end
              else
@@ -1088,6 +1113,11 @@ begin
                   PPIsSkipping := true;
                 end else
                   PPSkipMode := ppSkipElseBranch;
+                If LogEvent(sleConditionals) then
+                  if PPSkipMode=ppSkipElseBranch then
+                    DoLog(SLogIFDefAccepted,[Param])
+                  else
+                    DoLog(SLogIFDefRejected,[Param])
               end;
             end else if Directive = 'IFNDEF' then
             begin
@@ -1110,6 +1140,11 @@ begin
                   PPIsSkipping := true;
                 end else
                   PPSkipMode := ppSkipElseBranch;
+                If LogEvent(sleConditionals) then
+                  if PPSkipMode=ppSkipElseBranch then
+                    DoLog(SLogIFNDefAccepted,[Param])
+                  else
+                    DoLog(SLogIFNDefRejected,[Param])
               end;
             end else if Directive = 'IFOPT' then
             begin
@@ -1129,6 +1164,8 @@ begin
                 PPSkipMode := ppSkipIfBranch;
                 PPIsSkipping := true;
               end;
+              If LogEvent(sleConditionals) then
+                DoLog(SLogIFOPTIgnored,[Uppercase(Param)])
             end else if Directive = 'IF' then
             begin
               if PPSkipStackIndex = High(PPSkipModeStack) then
@@ -1146,6 +1183,8 @@ begin
                   just assumed as evaluating to false. }
                 PPSkipMode := ppSkipIfBranch;
                 PPIsSkipping := true;
+              If LogEvent(sleConditionals) then
+                 DoLog(SLogIFIgnored,[Uppercase(Param)])
               end;
             end else if Directive = 'ELSE' then
             begin
@@ -1200,9 +1239,28 @@ begin
   FCurToken := Result;
 end;
 
+function TPascalScanner.LogEvent(E: TPScannerLogEvent): Boolean;
+begin
+  Result:=E in FLogEvents;
+end;
+
 function TPascalScanner.GetCurColumn: Integer;
 begin
   Result := TokenStr - PChar(CurLine);
 end;
 
+procedure TPascalScanner.DoLog(const Msg: String;SkipSourceInfo : Boolean = False);
+begin
+  If Assigned(FOnLog) then
+    if SkipSourceInfo then
+      FOnLog(Self,Msg)
+    else
+      FOnLog(Self,Format('%s(%d) : %s',[FCurFileName,FCurRow,Msg]));
+end;
+
+procedure TPascalScanner.DoLog(const Fmt: String; Args: array of const;SkipSourceInfo : Boolean = False);
+begin
+  DoLog(Format(Fmt,Args),SkipSourceInfo);
+end;
+
 end.