Permalink
Browse files

implemented Exceptions interception and logging for FPC

- with call stack trace (if available)
- includes source code lines if compiled using -g or -gl switches
- tested on Win32, Win64, Linux i386 et x86_64 but should work on other OS :)
  • Loading branch information...
Arnaud Bouchez
Arnaud Bouchez committed Feb 6, 2018
1 parent d9fe9a5 commit 95c5d56edbcb641f716c36d78792853eae67c689
Showing with 181 additions and 89 deletions.
  1. +39 −21 SQLite3/Samples/11 - Exception logging/LoggingTest.dpr
  2. +7 −6 SynCommons.pas
  3. +131 −56 SynLog.pas
  4. +3 −5 Synopse.inc
  5. +1 −1 SynopseCommit.inc
@@ -16,15 +16,22 @@
}
program LoggingTest;
{$AppType console}
{$I Synopse.inc} // all expected conditionals
{$ifndef DELPHI5OROLDER} // mORMot.pas doesn't compile under Delphi 5
{$define WITHMORMOT}
{$endif}
uses
{$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
{$ifdef MSWINDOWS}
Windows,
ComObj,
{$endif}
SysUtils,
{$ifdef CONDITIONALEXPRESSIONS}
// mORMot.pas doesn't compile under Delphi 5
{$ifdef WITHMORMOT}
mORMot,
{$endif}
SynCommons,
@@ -41,7 +48,7 @@ type
// can be ignored on request
ECustomException = class(Exception);
{$ifdef CONDITIONALEXPRESSIONS}
{$ifdef WITHMORMOT}
TSQLRecordPeople = class(TSQLRecord)
private
fFirstName: RawUTF8;
@@ -89,7 +96,7 @@ end;
procedure TestsLog;
{$ifdef CONDITIONALEXPRESSIONS}
{$ifdef WITHMORMOT}
procedure TestPeopleProc;
var People: TSQLRecordPeople;
Log: ISynLog;
@@ -99,7 +106,7 @@ procedure TestsLog;
try
People.IDValue := 16;
People.FirstName := 'Louis';
People.LastName := 'Croivébaton';
People.LastName := 'Croivebaton';
People.YearOfBirth := 1754;
People.YearOfDeath := 1793;
Log.Log(sllInfo,People);
@@ -135,8 +142,11 @@ procedure TestsLog;
Proc1(n1, n2 - 1);
end;
var dummy: integer;
var i: integer;
f: system.TextFile;
info: TSynLogExceptionInfoDynArray;
begin
i := 1; // we need this to circumvent the FPC compiler :)
// first, set the TSQLLog family parameters
with TSQLLog.Family do begin
Level := LOG_VERBOSE;
@@ -149,24 +159,25 @@ begin
ArchiveAfterDays := 1; // archive after one day
end;
TSQLLog.Add.Log(sllInfo,'Starting');
// try some low-level common exceptions
writeln(' try some low-level common exceptions');
try
dummy := 0;
if 10 div dummy=0 then; // will raise EDivByZero
dec(i);
if 10 div i=0 then; // will raise EDivByZero
except
on E: exception do
TSQLLog.Add.Log(sllStackTrace,'^^^^^^^^ the first sample, divide by 0',E);
end;
try
readln; // will raise EIOError (no console is available to read from)
closefile(f);
readln(f); // will raise EIOError (no console is available to read from)
except
on E: exception do
TSQLLog.Add.Log(sllStackTrace,'^^^^^^^^ the next sample, I/O error',E);
end;
// try EAccessViolation in nested procedure calls (see stack trace)
writeln(' try EAccessViolation in nested procedure calls (see stack trace)');
Proc1(5,7);
Proc2(7,5);
// try a method recursive call, with an EAccessViolation raised within
writeln(' try a method recursive call, with an EAccessViolation raised within');
with TTestLogClass.Create do
try
try
@@ -177,56 +188,63 @@ begin
finally
Free;
end;
// try a procedure call with Enter/Auto-Leave
writeln(' try a procedure call with Enter/Auto-Leave');
TestLogProc;
{$ifdef CONDITIONALEXPRESSIONS}
// try a procedure call with Enter/Auto-Leave and a TSQLRecordPeople logging
{$ifdef WITHMORMOT}
writeln(' try a procedure call with Enter/Auto-Leave and a TSQLRecordPeople logging');
TestPeopleProc;
{$endif}
// try a custom Delphi exception
{$endif}
writeln(' try a custom Delphi exception');
try
raise ECustomException.Create('Test exception'); // logged to TSQLLog
except
on E: Exception do
TSQLLog.Add.Log(sllInfo,'^^^^^^^^ custom exception type',E);
end;
// try a custom Delphi exception after been marked as to be ignored
writeln(' try a custom Delphi exception after been marked as to be ignored');
TSQLLog.Family.ExceptionIgnore.Add(ECustomException);
try
raise ECustomException.Create('Test exception');
except
on E: Exception do
TSQLLog.Add.Log(sllInfo,'^^^^^^^^ nothing should be logged just above',E);
end;
// try an Exception with message='' - see ticket [388c2768b6]
writeln(' try an Exception with message='' - see ticket [388c2768b6]');
try
raise Exception.Create('');
except
on E: Exception do
TSQLLog.Add.Log(sllInfo,'^^^^^^^^ Exception.Message=""',E);
end;
// try an ESynException
writeln(' try an ESynException');
try
raise ESynException.CreateUTF8('testing %.CreateUTF8',[ESynException]);
except
on E: ESynException do begin
TSQLLog.Add.Log(sllInfo,'^^^^^^^^ ESynException',E);
{$ifdef WITHMORMOT}
TSQLLog.Add.Log(sllDebug,'ObjectToJSONDebug(E) = %',[ObjectToJSONDebug(E)],E);
{$endif}
TSQLLog.Add.Log(sllDebug,'FindLocation(E) = %',[TSynMapFile.FindLocation(E)],E);
end;
end;
{$ifdef MSWINDOWS}
// try a EOleSysError, as if it was triggered from the .Net CLR
writeln(' try a EOleSysError, as if it was triggered from the .Net CLR');
try
raise EOleSysError.Create('Test',HRESULT($80004003),0);
except
on E: Exception do
TSQLLog.Add.Log(sllInfo,'^^^^^^^^ should be recognized as NullReferenceException',E);
end;
{$endif}
writeln('GetLastExceptions = ');
GetLastExceptions(info);
for i := 0 to high(info) do
writeln(ToText(info[i]));
end;
begin
TestsLog;
writeln('------ finished');
end.
View
@@ -11381,13 +11381,15 @@ TSynLogExceptionContext = record
EAddr: PtrUInt;
/// the optional stack trace
EStack: PPtrUInt;
/// the logging level corresponding to this exception
// - may be either sllException or sllExceptionOS
ELevel: TSynLogInfo;
/// = FPC's RaiseProc() FrameCount if EStack is Frame: PCodePointer
EStackCount: integer;
/// the timestamp of this exception, as number of seconds since UNIX Epoch
// - UnixTimeUTC is faster than NowUTC or GetSystemTime
// - use UnixTimeToDateTime() to convert it into a regular TDateTime
ETimestamp: TUnixTime;
/// the logging level corresponding to this exception
// - may be either sllException or sllExceptionOS
ELevel: TSynLogInfo;
end;
/// global hook callback to customize exceptions logged by TSynLog
@@ -52415,14 +52417,13 @@ procedure TTextWriter.AddPointer(P: PtrUInt);
begin
if BEnd-B<=SizeOf(P)*2 then
FlushToStream;
{$ifdef CPU64}
{$ifdef CPU64} // truncate to for most heap-allocated 4 bytes pointers
if P and $ffffffff00000000<>0 then begin
BinToHexDisplay(@P,PAnsiChar(B+1),8);
inc(B,16);
exit;
end;
// truncate to 8 hexa chars for most heap-allocated pointers
{$endif}
{$endif}
Pointer4ToHex(@B[1],P);
inc(B,8);
end;
Oops, something went wrong.

0 comments on commit 95c5d56

Please sign in to comment.