05 May, 2010

New Exception class in Delphi 2009 and above

Exception class from SysUtils unit is a base class for all exceptions in your application. It wasn't changed since Delphi 2, if I remember correctly. But now, it got new properties and, thus, new features - starting with Delphi 2009 and above. So, I decided to give an overview of new capabilities of Exception class.

Okay, in Delphi 2007 and below, the Exception class looks like this:
type
  Exception = class(TObject)
  // ...
  public
    // All constructors below are just different variants of filling Message and HelpContext properties
    constructor Create(const Msg: string);
    // ...
    property HelpContext: Integer read FHelpContext write FHelpContext;
    property Message: string read FMessage write FMessage;
  end;

Actually, we have only a textual description of the problem here - Message property (HelpContext is barely used on practice). Of course, we can declare a new custom class, where we can add anything we like, but don't you think that base Exception class could be a more useful? How about information about previous exception?

Well, nevertheless, the Exception class has changed in Delphi 2009 (doh, finally!) by acquiring new properties and methods:
type
  Exception = class(TObject)
  // ...
  protected
    procedure SetInnerException;
    procedure SetStackInfo(AStackInfo: Pointer);
    function GetStackTrace: string;
    procedure RaisingException(P: PExceptionRecord); virtual;
  public
    constructor Create(const Msg: string);
    // ...
    function GetBaseException: Exception; virtual;
    function ToString: string; override;
    property BaseException: Exception read GetBaseException;
    property HelpContext: Integer read FHelpContext write FHelpContext;
    property InnerException: Exception read FInnerException;
    property Message: string read FMessage write FMessage;
    property StackTrace: string read GetStackTrace;
    property StackInfo: Pointer read FStackInfo;
  class var
    GetExceptionStackInfoProc: function (P: PExceptionRecord): Pointer;
    GetStackInfoStringProc: function (Info: Pointer): string;
    CleanUpStackInfoProc: procedure (Info: Pointer);
    class procedure RaiseOuterException(E: Exception); static;
    class procedure ThrowOuterException(E: Exception); static;
  end;
All new things belongs to one of the following categories:
  • Nested exceptions support
  • Exception tracing support
Let's deal with them individually.

Nested exceptions

Nested exception (sometimes called "chained exception") appears in situations, when new exception is raised, while your code processes another exception - i.e. if there is exception in exception handler (finally or except block). If you don't have support for nested exceptions - then old exception will be lost. Sometimes, it's what you want anyway, but sometimes it's not.

Two examples. A first one:
procedure TSomeClass.SaveToStream(const AStream: Stream);
begin
  try
    // ... saving instance to stream here
  except
    raise ESomeClassSaveError.Create('Error saving data to stream');
  end;
end;
I think that this example is quite clear. We raise high-level error (ESomeClassSaveError) from low-level error (it can be plain EStreamError due to out of disk space or something more tricky like range error or access violation due to damage of internal instance's state). Anyway, the user will get his description - and that was our target. However, note that information about original issue is lost, as high-level exception masked low-level one.

In this example, we've raised exception by ourself, as expected one. In the next example, this will be unexpected event.

Example two:
  SomeClass := TSomeClass.Create;
  try
    // ... suppose that there is some exception here
  finally
    FreeAndNil(SomeClass); // suppose that SomeClass's destructor raises exception too
  end;
In this example, we didn't expect exception to happen. We got unexpected exception in destructor of SomeClass instance. It may be some access violation, because we wasn't prepared for something. Similar to previous example: the new exception hides previous one, but we don't want it in this case - we want original exception, so we can fix it. We can only fix the second one without this information, which won't solve original problem.

Anyway, in both examples we leak important information: an information about previous exception, which can give us hints to the problem. And it is when nested exceptions appears.

The new exception class (whoa, that sure took a lot of time, but I should introduce newbies to nested exceptions after all) have InnerException and BaseException properties. Both properties are set (managed) by SysUtils unit automatically, you don't need to fill them manually. So, you can read and use them. InnerException property stores the previous exception. BaseException stores exception with most nested level - i.e. the very first exception, which started this exception chain. If there are only two exceptions in the chain (old and new, as in examples above), then InnerException will be equal to BaseException. If there is only one exception (i.e. there is no nested exception at all) - then both properties will be equal to nil.

Nested exceptions, however, aren't saved by default. In order to save nested exception, you need to raise new exceptions via Exception.RaiseOuterException (Delphi's style) or Exception.ThrowOuterException (C++ Builder's style). For example:
procedure TSomeClass.SaveToStream(const AStream: Stream);
begin
  try
    // ... saving instance to stream here
  except
    Exception.RaiseOuterException(ESomeClassSaveError.Create('Error saving data to stream'));
  end;
end;
After executing this code, we will get exception of ESomeClassSaveError class, which will have non-nil InnerException property (and BaseException too), which, in turn, will contain original exception (EStreamError or whatever it was).

In the second example (the one with exception in destructor) we still get InnerException = nil, cause RaiseOuterException isn't used anywhere.

How this support of nested exceptions affects error messages? Well, Message property didn't changed - it's a message of current exception only. So, any code, which isn't awared about nested exceptions, will show only message of the last exception. You can use ToString method of Exception class to show all messages from all exceptions - each exception will be on new line (obviously, ToString will be equal to Message property in case of single exception in the chain).

On the other side, Application.ShowException method looks a bit strange: this method shows message from BaseException - I suppose that it's not what you want (see our first example). That's why I think that you may want to make your own Application.OnException event handler to change this behaviour. For example:
procedure TForm1.ApplicationEvents1Exception(Sender: TObject; E: Exception);
var
  Msg: String;
begin
  Msg := E.Message; // or E.ToString
  Application.MessageBox(PChar(Msg), PChar(Application.Title), MB_OK + MB_ICONSTOP);
end;
The next thing: I really don't understand, why there is no way to enable capturing of nested exceptions in each case, without need to use special raising routines. If you want this feature - you may add the following unit to your uses clause (attention: this is a hack, not documented way):
unit ChainedExceptionsAlways;

interface

implementation

uses
  SysUtils;

var
  OldRaiseExceptObject: Pointer;

type
  EExceptionHack = class
  public
    FMessage: string;
    FHelpContext: Integer;
    FInnerException: Exception;
    FStackInfo: Pointer;
    FAcquireInnerException: Boolean;
  end;

procedure RaiseExceptObject(P: PExceptionRecord);
type
  TRaiseExceptObjectProc = procedure(P: PExceptionRecord);
begin
  if TObject(P^.ExceptObject) is Exception then
    EExceptionHack(P^.ExceptObject).FAcquireInnerException := True;

  if Assigned(OldRaiseExceptObject) then
    TRaiseExceptObjectProc(OldRaiseExceptObject)(P);
end;

initialization
  OldRaiseExceptObject := RaiseExceptObjProc;
  RaiseExceptObjProc := @RaiseExceptObject;
end.
After you add this unit (the sooner - the better) - our second example will start to collect previous exceptions too, and you can use either Exception.RaiseOuterException or just raise in the first example - the behaviour will be the same.

Exception tracing

Well, if you read our blog from time to time or if you're using EurekaLog - you're already familiar with exception tracers, so I'll skip introduction here, but I still want to briefly describe architecture of exception tracers to show how new properties of new Exception class fit in this picture.

Application is set of machine's codes, which are just numbers in bytes. By default, there is no reference to source code in the compiled application. That's why you can't built a human-readable call stack. So, you need to use some solution, which do the following:
  • Embeds debug information (reference between raw code and sources) into compiled application in public or proprietary format.
  • Installs hook on exception's raising (i.e. hook on any function, which is called when exception occurs). This includes patching of something (import table or code's section).
  • Builds a call stack in the hook handler by using any stack tracing method.
There is no problem with first and third item - they are documented and acceptable solutions. Item two is different, as it includes using of dirty hacks. That's why, Delphi's developers have added support for exception tracers in Exception class to simplify things here (it's a bit late, but late is still better, than never). All that this support do - it allows you to call your routine at exception raise, removing need to hook/patch binary. Nothing more, nothing less. In other words, there is no way to get exception tracing in Delphi out of the box.

One more time: this new feature is designed for developers of exception tracers.

Since all already written exception tracers already works somehow - they do not use this new feature, that's why, if you want to get exception's call stack, then you need to call appropriate function of exception tracer. For example, it's GetLastExceptionCallStack for EurekaLog and JclLastExceptStackList for JCL.

However, you can integrate any existing exception tracer into this new architecture - and this task is quite simple. If your exception tracer consists of distinct modules, you can turn off that part, which is responsible for hooking, leaving only stack tracing and debug information parts.

Okay, so if you've decided that you want it, here is how you can do it.

First thing is that the mentioned support includes System and SysUtils units. All base functionality is included into System unit - similar to old features of exceptions. SysUtils unit is just a convenient "wrapper" for System unit's functionality. System unit provides certain events (ExceptProc, ErrorProc, ExceptClsProc, ExceptObjProc, RaiseExceptionProc, RTLUnwindProc, RaiseExceptObjProc, ExceptionAcquired, ExceptionClass, SafeCallErrorProc, AssertErrorProc and AbstractErrorProc), which SysUtils unit uses. You should not use these events, until you throw out SysUtils unit. Instead, use SysUtils's services.

So, what SysUtils unit can offer us? It offers a new Exception class, which have new events like GetExceptionStackInfoProc, GetStackInfoStringProc and CleanUpStackInfoProc. They aren't used by anyone by default - as I said, it's impossible to implement them, as default application doesn't have information for that.

This means that it's we, who need to implement these handlers. Since we don't write exception tracer, but use already existing one - we only need to write a wrapper. Wrapper will just call appropriate function from exception tracer, that's all. For example:
unit ExceptionEurekaLogSupport;

interface

implementation

uses
  SysUtils, Classes, ExceptionLog;

function GetExceptionStackInfoEurekaLog(P: PExceptionRecord): Pointer;
const
  cDelphiException = $0EEDFADE;
var
  Stack: TEurekaStackList;
  Str: TStringList;
  Trace: String;
  Sz: Integer;
  DI: PEurekaDebugInfo;
begin
  Stack := GetCurrentCallStack;
  try
    New(DI);
    DI^.ModuleInfo := ModuleInfoByAddr(Cardinal(P^.ExceptAddr));
    if P^.ExceptionCode = cDelphiException then
      GetSourceInfoByAddr(Cardinal(P^.ExceptAddr), DI)
    else
      GetSourceInfoByAddr(Cardinal(P^.ExceptionAddress), DI);
    Stack.Insert(0, DI);

    Str := TStringList.Create;
    try
      CallStackToStrings(Stack, Str);
      Trace := Str.Text;
    finally
      FreeAndNil(Str);
    end;
  finally
    FreeAndNil(Stack);
  end;

  if Trace <> '' then
  begin
    Sz := (Length(Trace) + 1) * SizeOf(Char);
    GetMem(Result, Sz);
    Move(Pointer(Trace)^, Result^, Sz);
  end
  else
    Result := nil;
end;

function GetStackInfoStringEurekaLog(Info: Pointer): string;
begin
  Result := PChar(Info);
end;

procedure CleanUpStackInfoEurekaLog(Info: Pointer);
begin
  FreeMem(Info);
end;

initialization
  Exception.GetExceptionStackInfoProc := GetExceptionStackInfoEurekaLog;
  Exception.GetStackInfoStringProc := GetStackInfoStringEurekaLog;
  Exception.CleanUpStackInfoProc := CleanUpStackInfoEurekaLog;
end.
And here is variant for JCL:
unit ExceptionJCLSupport;

interface

implementation

uses
  SysUtils, Classes, JclDebug;

function GetExceptionStackInfoJCL(P: PExceptionRecord): Pointer;
const
  cDelphiException = $0EEDFADE;
var
  Stack: TJclStackInfoList;
  Str: TStringList;
  Trace: String;
  Sz: Integer;
begin
  if P^.ExceptionCode = cDelphiException then
    Stack := JclCreateStackList(False, 3, P^.ExceptAddr)
  else
    Stack := JclCreateStackList(False, 3, P^.ExceptionAddress);
  try
    Str := TStringList.Create;
    try
      Stack.AddToStrings(Str, True, True, True, True);
      Trace := Str.Text;
    finally
      FreeAndNil(Str);
    end;
  finally
    FreeAndNil(Stack);
  end;

  if Trace <> '' then
  begin
    Sz := (Length(Trace) + 1) * SizeOf(Char);
    GetMem(Result, Sz);
    Move(Pointer(Trace)^, Result^, Sz);
  end
  else
    Result := nil;
end;

function GetStackInfoStringJCL(Info: Pointer): string;
begin
  Result := PChar(Info);
end;

procedure CleanUpStackInfoJCL(Info: Pointer);
begin
  FreeMem(Info);
end;

initialization
  Exception.GetExceptionStackInfoProc := GetExceptionStackInfoJCL;
  Exception.GetStackInfoStringProc := GetStackInfoStringJCL;
  Exception.CleanUpStackInfoProc := CleanUpStackInfoJCL;
end.
Depending on the exception tracer that you use - you need to include either one of these units into uses clause (the sooner - the better) and you'll magically have your stack traces.

Use the following example of OnException handler to verify that it's working (note that you need to turn on RTL handlers calling and turn off EurekaLog's dialog in EurekaLog options):
procedure TForm1.ApplicationEvents1Exception(Sender: TObject; E: Exception);
var
  Msg, Stack: String;
  Inner: Exception;
begin
  Inner := E;
  Msg := '';
  while Inner <> nil do
  begin
    if Msg <> '' then
      Msg := Msg + sLineBreak;
    Msg := Msg + Inner.Message;
    if (Msg <> '') and (Msg[Length(Msg)] > '.') then
      Msg := Msg + '.';

    Stack := Inner.StackTrace;
    if Stack <> '' then
    begin
      if Msg <> '' then
        Msg := Msg + sLineBreak + sLineBreak;
      Msg := Msg + Stack + sLineBreak;
    end;

    Inner := Inner.InnerException;
  end;
  Application.MessageBox(PChar(Msg), PChar(Application.Title), MB_OK + MB_ICONSTOP);
end;
Let's see example. The following code:
procedure TForm1.Button1Click(Sender: TObject);
begin
  try
    PInteger(nil)^ := 0;
  except
    Exception.RaiseOuterException(Exception.Create('Error occured'));
  end;
end;
will produce the following message box:
Error occured.

(000A7D0F){Project68.exe} [004A8D0F] Unit1.TForm1.Button1Click (Line 61, "Unit1.pas" + 4) + $16
(00004901){Project68.exe} [00405901] System.@RaiseExcept (Line 12194, "System.pas" + 47) + $0
(00076473){Project68.exe} [00477473] Controls.TControl.Click (Line 7178, "Controls.pas" + 9) + $8
(0007A7CC){Project68.exe} [0047B7CC] Controls.TWinControl.WndProc (Line 9819, "Controls.pas" + 144) + $6
(00057BE4){Project68.exe} [00458BE4] StdCtrls.TButtonControl.WndProc (Line 4377, "StdCtrls.pas" + 13) + $4
(0007A91F){Project68.exe} [0047B91F] Controls.DoControlMsg (Line 9888, "Controls.pas" + 12) + $11
(0007A7CC){Project68.exe} [0047B7CC] Controls.TWinControl.WndProc (Line 9819, "Controls.pas" + 144) + $6
(0009AC94){Project68.exe} [0049BC94] Forms.TCustomForm.WndProc (Line 3960, "Forms.pas" + 191) + $5
(00079E6C){Project68.exe} [0047AE6C] Controls.TWinControl.MainWndProc (Line 9540, "Controls.pas" + 3) + $6
(0003DC58){Project68.exe} [0043EC58] Classes.StdWndProc (Line 13014, "Classes.pas" + 8) + $0
(0007A8CC){Project68.exe} [0047B8CC] Controls.TWinControl.DefaultHandler (Line 9860, "Controls.pas" + 30) + $17
(0007A7CC){Project68.exe} [0047B7CC] Controls.TWinControl.WndProc (Line 9819, "Controls.pas" + 144) + $6
(00057BE4){Project68.exe} [00458BE4] StdCtrls.TButtonControl.WndProc (Line 4377, "StdCtrls.pas" + 13) + $4
(0003DC58){Project68.exe} [0043EC58] Classes.StdWndProc (Line 13014, "Classes.pas" + 8) + $0

Access violation at address 004A8CE8 in module 'Project1.exe'. Write of address 00000000.

(000A7CE8){Project68.exe} [004A8CE8] Unit1.TForm1.Button1Click (Line 59, "Unit1.pas" + 2) + $4
(0000453F){Project68.exe} [0040553F] System.@HandleAnyException (Line 11245, "System.pas" + 13) + $0
(00076473){Project68.exe} [00477473] Controls.TControl.Click (Line 7178, "Controls.pas" + 9) + $8
(0007A7CC){Project68.exe} [0047B7CC] Controls.TWinControl.WndProc (Line 9819, "Controls.pas" + 144) + $6
(00057BE4){Project68.exe} [00458BE4] StdCtrls.TButtonControl.WndProc (Line 4377, "StdCtrls.pas" + 13) + $4
(0007A91F){Project68.exe} [0047B91F] Controls.DoControlMsg (Line 9888, "Controls.pas" + 12) + $11
(0007A7CC){Project68.exe} [0047B7CC] Controls.TWinControl.WndProc (Line 9819, "Controls.pas" + 144) + $6
(0009AC94){Project68.exe} [0049BC94] Forms.TCustomForm.WndProc (Line 3960, "Forms.pas" + 191) + $5
(00079E6C){Project68.exe} [0047AE6C] Controls.TWinControl.MainWndProc (Line 9540, "Controls.pas" + 3) + $6
(0003DC58){Project68.exe} [0043EC58] Classes.StdWndProc (Line 13014, "Classes.pas" + 8) + $0
(0007A8CC){Project68.exe} [0047B8CC] Controls.TWinControl.DefaultHandler (Line 9860, "Controls.pas" + 30) + $17
(0007A7CC){Project68.exe} [0047B7CC] Controls.TWinControl.WndProc (Line 9819, "Controls.pas" + 144) + $6
(00057BE4){Project68.exe} [00458BE4] StdCtrls.TButtonControl.WndProc (Line 4377, "StdCtrls.pas" + 13) + $4
(0003DC58){Project68.exe} [0043EC58] Classes.StdWndProc (Line 13014, "Classes.pas" + 8) + $0
Also note, that (in case of JCL) we do not use hooking code (which is located in JclHookExcept unit), since new Exception class takes care of that for us. We only use JCL's features on stack tracing and debug information (which are located in JclDebug unit).