From ad1d5994bb4f44e14c1caa93ceaf7ed917f64d9a Mon Sep 17 00:00:00 2001 From: mattias Date: Sun, 13 Feb 2011 09:41:35 +0000 Subject: [PATCH] codetools: ppu tool: error handling git-svn-id: trunk@29503 - --- components/codetools/ppucodetools.pas | 77 +++++++++++++++++++++++++-- components/codetools/ppugraph.pas | 2 +- components/codetools/ppuparser.pas | 34 ++++++++---- 3 files changed, 98 insertions(+), 15 deletions(-) diff --git a/components/codetools/ppucodetools.pas b/components/codetools/ppucodetools.pas index 7256aadcb2..563e466b03 100644 --- a/components/codetools/ppucodetools.pas +++ b/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; diff --git a/components/codetools/ppugraph.pas b/components/codetools/ppugraph.pas index 3a085983da..474ee35b5c 100644 --- a/components/codetools/ppugraph.pas +++ b/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]); diff --git a/components/codetools/ppuparser.pas b/components/codetools/ppuparser.pas index 98fa66e9e8..df80a12268 100644 --- a/components/codetools/ppuparser.pas +++ b/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;