codetools: ppu tool: error handling

git-svn-id: trunk@29503 -

components/codetools/ppucodetools.pas

@@ -55,7 +55,12 @@ type
 
   TPPUTools = class
   private
+    FCatchExceptions: boolean;
+    FErrorFilename: string;
+    fErrorMsg: string;
     fItems: TAVLTree; // tree of TPPUTool sorted for Code
+    FWriteExceptions: boolean;
+    procedure WriteError;
   public
     constructor Create;
     destructor Destroy; override;
@@ -65,6 +70,17 @@ type
     function LoadFile(const NormalizedFilename: string;
                       const Parts: TPPUParts = PPUPartsAll): TPPUTool;
 
+    // error handling
+    procedure ClearError;
+    function HandleException(AnException: Exception): boolean;
+    procedure SetError(TheFilename: string; const TheMessage: string);
+    property CatchExceptions: boolean
+                                   read FCatchExceptions write FCatchExceptions;
+    property WriteExceptions: boolean
+                                   read FWriteExceptions write FWriteExceptions;
+    property ErrorFilename: string read FErrorFilename;
+    property ErrorMessage: string read fErrorMsg;
+
     // uses section
     function GetMainUsesSectionNames(NormalizedFilename: string; var List: TStrings): boolean;
     function GetImplementationUsesSectionNames(NormalizedFilename: string; var List: TStrings): boolean;
@@ -87,9 +103,23 @@ end;
 
 { TPPUTools }
 
+procedure TPPUTools.WriteError;
+begin
+  if FWriteExceptions then begin
+    DbgOut('### TPPUTools.HandleException: "'+ErrorMessage+'"');
+    if ErrorFilename<>'' then DbgOut(' in file="',ErrorFilename,'"');
+    DebugLn('');
+    {$IFDEF CTDEBUG}
+    //WriteDebugReport();
+    {$ENDIF}
+  end;
+end;
+
 constructor TPPUTools.Create;
 begin
   fItems:=TAVLTree.Create(@ComparePPUTools);
+  CatchExceptions:=true;
+  WriteExceptions:=true;
 end;
 
 destructor TPPUTools.Destroy;
@@ -141,16 +171,53 @@ begin
   Result:=Tool;
 end;
 
+procedure TPPUTools.ClearError;
+begin
+  FErrorFilename:='';
+  fErrorMsg:='';
+end;
+
+function TPPUTools.HandleException(AnException: Exception): boolean;
+var
+  PPU: TPPU;
+begin
+  fErrorMsg:=AnException.Message;
+  if (AnException is EPPUParserError) then begin
+    PPU:=EPPUParserError(AnException).Sender;
+    if PPU<>nil then begin
+      if PPU.Owner is TPPUTool then begin
+        FErrorFilename:=TPPUTool(PPU.Owner).Filename;
+      end;
+    end;
+  end;
+  // write error
+  WriteError;
+  // raise or catch
+  if not CatchExceptions then raise AnException;
+  Result:=false;
+end;
+
+procedure TPPUTools.SetError(TheFilename: string; const TheMessage: string);
+begin
+  FErrorFilename:=TheFilename;
+  fErrorMsg:=TheMessage;
+  WriteError;
+end;
+
 function TPPUTools.GetMainUsesSectionNames(NormalizedFilename: string;
   var List: TStrings): boolean;
 var
   Tool: TPPUTool;
 begin
   Result:=false;
-  Tool:=LoadFile(NormalizedFilename,[ppInterfaceHeader]);
-  if Tool=nil then exit;
-  Tool.PPU.GetMainUsesSectionNames(List);
-  Result:=true;
+  try
+    Tool:=LoadFile(NormalizedFilename,[ppInterfaceHeader]);
+    if Tool=nil then exit;
+    Tool.PPU.GetMainUsesSectionNames(List);
+    Result:=true;
+  except
+    on e: Exception do Result:=HandleException(e);
+  end;
 end;
 
 function TPPUTools.GetImplementationUsesSectionNames(
@@ -193,7 +260,7 @@ begin
   Result:=false;
   ErrorMsg:='';
   if PPU=nil then
-    PPU:=TPPU.Create;
+    PPU:=TPPU.Create(Self);
   try
     LoadDate:=FileDateOnDisk;
     LoadedParts:=Parts;

components/codetools/ppugraph.pas

@@ -204,7 +204,7 @@ begin
   ImplementationUses.Clear;
   InitializationMangledName:='';
   FinalizationMangledName:='';
-  if PPU=nil then PPU:=TPPU.Create;
+  if PPU=nil then PPU:=TPPU.Create(Self);
   PPU.LoadFromFile(PPUFilename);
   debugln('================================================================');
   DebugLn(['TPPUMember.UpdatePPU Group=',Group.Name,' AUnitName=',Unit_Name,' Filename=',PPUFilename]);

components/codetools/ppuparser.pas

@@ -32,7 +32,7 @@ unit PPUParser;
 
 {$mode objfpc}{$H+}
 
-{$DEFINE VerbosePPUParser}
+{off $DEFINE VerbosePPUParser}
 
 interface
 
@@ -486,10 +486,14 @@ type
     nr   : byte;
   end;
   PPPUEntry = ^TPPUEntry;
+
+  TPPU = class;
   
   { EPPUParserError }
 
   EPPUParserError = class(Exception)
+    Sender: TPPU;
+    constructor Create(ASender: TPPU; const AMessage: string);
   end;
 
   { TPPU }
@@ -503,6 +507,7 @@ type
     FEntryPos: integer;
     FEntryBuf: Pointer;
     FEntryBufSize: integer;
+    FOwner: TObject;
     FVersion: integer;
     FDerefData: PByte;
     FDerefDataSize: integer;
@@ -557,7 +562,7 @@ type
     procedure SetDataPos(NewPos: integer);
     function GetProcMangledName(ProcDefPos: integer): string;
   public
-    constructor Create;
+    constructor Create(TheOwner: TObject);
     destructor Destroy; override;
     procedure Clear;
     procedure LoadFromStream(s: TStream; const Parts: TPPUParts = PPUPartsAll);
@@ -569,6 +574,7 @@ type
     function GetInitProcName: string;
     function GetFinalProcName: string;
     property Version: integer read FVersion;
+    property Owner: TObject read FOwner;
   end;
 
 function PPUTargetToStr(w: longint): string;
@@ -861,6 +867,14 @@ begin
   Result := L0(Year)+'/'+L0(Month)+'/'+L0(Day)+' '+L0(Hour)+':'+L0(min)+':'+L0(sec);
 end;
 
+{ EPPUParserError }
+
+constructor EPPUParserError.Create(ASender: TPPU; const AMessage: string);
+begin
+  Sender:=ASender;
+  inherited Create(AMessage);
+end;
+
 { TPPU }
 
 procedure TPPU.ReadPPU(const Parts: TPPUParts);
@@ -1776,8 +1790,9 @@ begin
     if FVersion>=107 then begin
       // svn rev 14503  ppu ver 107
       {$IFDEF VerbosePPUParser}IndirectCRC:={$ENDIF}ReadEntryDWord;
-    end else
-      IndirectCRC:=0;
+    end else begin
+      {$IFDEF VerbosePPUParser}IndirectCRC:=0;{$ENDIF}
+    end;
     {$IFDEF VerbosePPUParser}
     DebugLn(['TPPU.ReadUsedUnits Unit=',AUnitName,' CRC=',HexStr(cardinal(CRC),8),' IntfCRC=',HexStr(cardinal(IntfCRC),8),' IndCRC=',HexStr(cardinal(IndirectCRC),8)]);
     {$ENDIF}
@@ -1964,7 +1979,7 @@ begin
   {$IFDEF VerbosePPUParser}
   CTDumpStack;
   {$ENDIF}
-  raise EPPUParserError.Create(Msg);
+  raise EPPUParserError.Create(Self,Msg);
 end;
 
 procedure TPPU.GetUsesSection(StartPos: integer; var List: TStrings);
@@ -1980,8 +1995,9 @@ begin
       List:=TStringList.Create;
     if List.IndexOf(AUnitName)<0 then
       List.Add(AUnitName);
-    ReadEntryLongint; // CRC
-    ReadEntryLongint; // IntfCRC
+    ReadEntryDWord; // CRC
+    ReadEntryDWord; // IntfCRC
+    if FVersion>=107 then ReadEntryDWord;
   end;
 end;
 
@@ -2008,9 +2024,9 @@ begin
     Result:=ReadEntryShortstring;
 end;
 
-constructor TPPU.Create;
+constructor TPPU.Create(TheOwner: TObject);
 begin
-
+  FOwner:=TheOwner;
 end;
 
 destructor TPPU.Destroy;