Updated 28 May 2014: Removed extraneous unit reference from AttributeValidation.pas. Sorry…

What problem was I trying to solve?

Recently, while using the Indy Internet components in Delphi XE2, I was struggling to track the thread contexts in which certain code paths ran, to ensure that resource contention and deadlocks were correctly catered for.

Indy components are reasonably robust, but use a multithreaded model which it turns out is difficult to get 100% correct.  Component callbacks can occur on many different threads:

• The thread that constructed the component
• The VCL thread
• The server listener thread
• The connection’s thread
• Some, e.g. exceptions, can occur on any thread

Disentangling this, especially when in conjunction with third party solutions that are based on Indy and may add several layers of indirection, quickly becomes an unenjoyable task.

I started adding thread validation assertions to each function to ensure that I was (a) understanding which thread context the function was actually running in, and (b) to ensure that I didn’t call the function in the wrong context myself.  However, when browsing the code, it was still very difficult to get a big picture view of thread usage.

Introducing attributes

Enter attributes.  Delphi 2010 introduced support for attributes in Win32, and a nice API to query them with extended Run Time Type Information (RTTI).  This is nice, except for one thing: it’s difficult at runtime to find the RTTI associated with the current method.

In this unit, I have tried to tick a number of boxes:

• Create a simple framework for extending runtime testing of classes with attributes
• Use attributes to annotate methods, in this case about thread safety, to optimise self-documentation
• Keep a single, consistent function call in each member method, to test any attributes associated with that method.
• Sensible preprocessor use to enable and disable both the testing and full RTTI in one place.

One gotcha is that by default, RTTI for Delphi methods is only available for public and published member methods.  This can be changed with the $RTTI compiler directive but you have to remember to do it in each unit!  I have used a unit-based $I include in order to push the correct RTTI settings consistently.

I’ve made use of Delphi’s class helper model to give direct access to any object at compile time.  This is a clean way of injecting this support into all classes which are touched by the RTTI, but does create larger executables.  I believe this to be a worthwhile tradeoff.

Example code

The code sample below demonstrates how to use the attribute tests in a multi-threaded context. In this example, an assertion will be raised soon after cmdDoSomeHardWorkClick is called. Why is this? It happens because the HardWorkCallback function on the main thread is annotated with [MainThread] attribute, but it will be called from TSomeThread‘s thread context, not the main thread.

In order for the program run without an assertion, you could change the annotation of HardWorkCallback to [NotMainThread]. Making this serves as an immediate prompt that you should not be accessing VCL properties, because you are no longer running on the main thread. In fact, unless you can prove that the lifetime of the form will exceed that of TSomeThread, you shouldn’t even be referring to the form. The HardWorkCallback function here violates these principles by referring to the Handle property of TForm. However, because we can show that the form is destroyed after the thread exits, it’s safe to make the callback to the TAttrValForm object itself.

You can download the full source for this project from the link at the bottom of this post in order to compile it and run it yourself.

Exercise: How could you restructure this to make HardWorkCallback thread-safe? There’s more than one way to skin this cat.

unit AttrValSample;

interface

uses
  System.Classes,
  System.SyncObjs,
  System.SysUtils,
  System.Variants,
  Vcl.Controls,
  Vcl.Dialogs,
  Vcl.Forms,
  Vcl.Graphics,
  Vcl.StdCtrls,
  Winapi.Messages,
  Winapi.Windows,

  {$I AttributeValidation.inc};

type
  TSomeThread = class;

  TAttrValForm = class(TForm)
    cmdStartThread: TButton;
    cmdDoSomeHardWork: TButton;
    cmdStopThread: TButton;
    procedure cmdStartThreadClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure cmdStopThreadClick(Sender: TObject);
    procedure cmdDoSomeHardWorkClick(Sender: TObject);
  private
    FThread: TSomeThread;
  public
    [MainThread] procedure HardWorkCallback;
  end;

  TSomeThread = class(TThread)
  private
    FOwner: TAttrValForm;
    FEvent: TEvent;
    [NotMainThread] procedure HardWork;
  protected
    [NotMainThread] procedure Execute; override;
  public
    [MainThread] constructor Create(AOwner: TAttrValForm);
    [MainThread] destructor Destroy; override;
    [MainThread] procedure DoSomeHardWork;
  end;

var
  AttrValForm: TAttrValForm;

implementation

{$R *.dfm}

procedure TAttrValForm.cmdStartThreadClick(Sender: TObject);
begin
  FThread := TSomeThread.Create(Self);

  cmdDoSomeHardWork.Enabled := True;
  cmdStopThread.Enabled := True;
  cmdStartThread.Enabled := False;
end;

procedure TAttrValForm.cmdDoSomeHardWorkClick(Sender: TObject);
begin
  FThread.DoSomeHardWork;
end;

procedure TAttrValForm.cmdStopThreadClick(Sender: TObject);
begin
  FreeAndNil(FThread);
  cmdDoSomeHardWork.Enabled := False;
  cmdStopThread.Enabled := False;
  cmdStartThread.Enabled := True;
end;

procedure TAttrValForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FThread);
end;

procedure TAttrValForm.HardWorkCallback;
begin
  ValidateAttributes;
  SetWindowText(Handle, 'Hard work done');
end;

{ TSomeThread }

constructor TSomeThread.Create(AOwner: TAttrValForm);
begin
  ValidateAttributes;
  FEvent := TEvent.Create(nil, False, False, '');
  FOwner := AOwner;
  inherited Create(False);
end;

destructor TSomeThread.Destroy;
begin
  ValidateAttributes;
  if not Terminated then
  begin
    Terminate;
    FEvent.SetEvent;
    WaitFor;
  end;
  FreeAndNil(FEvent);
  inherited Destroy;
end;

procedure TSomeThread.DoSomeHardWork;
begin
  ValidateAttributes;
  FEvent.SetEvent;
end;

procedure TSomeThread.Execute;
begin
  ValidateAttributes;
  while not Terminated do
  begin
    if FEvent.WaitFor = wrSignaled then
      if not Terminated then
        HardWork;
  end;
end;

procedure TSomeThread.HardWork;
begin
  ValidateAttributes;
  FOwner.HardWorkCallback;
end;

end.

The AttributeValidation.inc file referenced in the uses clause above controls RTTI and debug settings, in one line. This pattern makes it easy to use the unit without forgetting to set the appropriate RTTI flags in one unit.

// Disable the following $DEFINE to remove all validation from the project
// You may want to do this with {$IFDEF DEBUG} ... {$ENDIF}
{$DEFINE ATTRIBUTE_DEBUG}

// Shouldn't need to touch anything below here
{$IFDEF ATTRIBUTE_DEBUG}
{$RTTI EXPLICIT METHODS([vcPrivate,vcProtected,vcPublic,vcPublished])}
{$ENDIF}

// This .inc file is also included from AttributeValidation.pas, so
// don't use it again in that context.
{$IFNDEF ATTRIBUTE_DEBUG_UNIT}
AttributeValidation
{$ENDIF}

Finally, the AttributeValidation.pas file itself contains the assembly stub to capture the return address for the caller, and the search through the RTTI for the appropriate method to test in each case. This will have a performance cost so should really only be present in Debug builds.

unit AttributeValidation;

interface

{$DEFINE ATTRIBUTE_DEBUG_UNIT}
{$I AttributeValidation.inc}

uses
  System.Rtti;

type
  // Base class for all validation attributes
  ValidationAttribute = class(TCustomAttribute)
    function Execute(Method: TRTTIMethod): Boolean; virtual;
  end;

  // Will log to the debug console whenever a deprecated
  // function is called
  DeprecatedAttribute = class(ValidationAttribute)
    function Execute(Method: TRTTIMethod): Boolean; override;
  end;

  // Base class for all thread-related attributes
  ThreadAttribute = class(ValidationAttribute);

  // This indicates that the procedure can be called from
  // any thread.  No test to pass, just a bare attribute
  ThreadSafeAttribute = class(ThreadAttribute);

  // This indicates that the procedure must only be called
  // in the context of the main thread
  MainThreadAttribute = class(ThreadAttribute)
    function Execute(Method: TRTTIMethod): Boolean; override;
  end;

  // This indicates that the procedure must only be called
  // in another thread context.
  NotMainThreadAttribute = class(ThreadAttribute)
    function Execute(Method: TRTTIMethod): Boolean; override;
  end;

  TAttributeValidation = class helper for TObject
{$IFDEF ATTRIBUTE_DEBUG}
  private
    procedure IntValidateAttributes(FReturnAddress: UIntPtr);
{$ENDIF}
  protected
    procedure ValidateAttributes;
  end;

implementation

uses
  Winapi.Windows,

  classes;

{ TAttributeValidation }

{
 Function:    TAttributeValidation.ValidateAttributes

 Description: Save the return address to an accessible variable
              on the stack.  We could do this with pure Delphi and
              some pointer jiggery-pokery, but this is cleaner.
}
{$IFNDEF ATTRIBUTE_DEBUG}
procedure TAttributeValidation.ValidateAttributes;
begin
end;
{$ELSE}
{$IFDEF CPUX64}
procedure TAttributeValidation.ValidateAttributes;
asm
  push rbp
  sub  rsp, $20
  mov  rbp, rsp
                          // rcx = param 1; will already be pointing to Self.
  mov  rdx, [rbp+$28]     // rdx = param 2; rbp+$28 is return address on stack
  call TAttributeValidation.IntValidateAttributes;

  lea  rsp, [rbp+$20]
  pop  rbp
end;
{$ELSE}
procedure TAttributeValidation.ValidateAttributes;
asm
                            // eax = Self
  mov edx, dword ptr [esp]  // edx = parameter 1
  call TAttributeValidation.IntValidateAttributes
end;
{$ENDIF}

{
 Function:    TAttributeValidation.IntValidateAttributes

 Description: Find the closest function to the return address,
              and test the attributes in that function.  Assumes
              that the closest function is the correct one, so
              if RTTI is missing then you'll be in a spot of
              bother.
}
procedure TAttributeValidation.IntValidateAttributes(FReturnAddress: UIntPtr);
var
  FRttiType: TRttiType;
  FClosestRttiMethod, FRttiMethod: TRTTIMethod;
  FAttribute: TCustomAttribute;
begin
  with TRttiContext.Create do
  try
    FRttiType := GetType(ClassType);
    if not Assigned(FRttiType) then Exit;

    FClosestRttiMethod := nil;

    // Find nearest function for the return address
    for FRttiMethod in FRttiType.GetMethods do
    begin
      if (UIntPtr(FRttiMethod.CodeAddress) <= FReturnAddress) then
      begin
        if not Assigned(FClosestRttiMethod) or
            (UIntPtr(FRttiMethod.CodeAddress) > UIntPtr(FClosestRttiMethod.CodeAddress)) then
          FClosestRttiMethod := FRttiMethod;
      end;
    end;

    // Check attributes for the function
    if Assigned(FClosestRttiMethod) then
    begin
      for FAttribute in FClosestRttiMethod.GetAttributes do
      begin
        if FAttribute is ValidationAttribute then
        begin
          if not (FAttribute as ValidationAttribute).Execute(FClosestRttiMethod) then
          begin
            Assert(False, 'Attribute '+FAttribute.ClassName+' did not validate on '+FClosestRttiMethod.Name);
          end;
        end;
      end;
    end;
  finally
    Free;
  end;
end;
{$ENDIF}

{ ValidationAttribute }

function ValidationAttribute.Execute(Method: TRTTIMethod): Boolean;
begin
  Result := True;
end;

{ MainThreadAttribute }

function MainThreadAttribute.Execute(Method: TRTTIMethod): Boolean;
begin
  Result := GetCurrentThreadID = MainThreadID;
end;

{ NotMainThreadAttribute }

function NotMainThreadAttribute.Execute(Method: TRTTIMethod): Boolean;
begin
  Result := GetCurrentThreadID <> MainThreadID;
end;

{ DeprecatedAttribute }

function DeprecatedAttribute.Execute(Method: TRTTIMethod): Boolean;
begin
  OutputDebugString(PChar(Method.Name + ' was called.'#13#10));
  Result := True;
end;

end.

There you have it — a “real” use case for attributes in Delphi. The key advantages I see to this approach, as opposed to, say function-level assertions, is that a birds-eye view of your class will help you to understand the preconditions for each member function, and these preconditions can be consistently and simply tested.

Using a class helper makes it easy to inject the additional functionality into every class that is touched by attribute validation, without polluting the class hierarchy. This means that attribute tests can be seamlessly added to existing infrastructure and Delphi child classes such as TForm.

Full source: AttrVal.zip. License: MPL 2.0. YMMV and use at your own risk.

Some Delphi types do not have RTTI. This is no fun. This happens when, and I quote:

whereas enumerated constants with a specific value, such as the following, do not have RTTI:
type SomeEnum = (e1 = 1, e2 = 2, e3 = 3);

In normal use, this will go unnoticed, and not cause you any grief, until you throw these enumerated types into a generic construct (or have any other need to use RTTI). As soon as you do that, you’ll start getting the unhelpful and misleading “Invalid Class Typecast” exception. (No it’s not a Class!)

To avoid this problem, you must wander into the dark world of pointer casting, because once you are pointing at some data, Delphi no longer cares what its actual type is.

Here’s an example of how to convert a Variant value into a generic type, including support for RTTI-free enums, in a reasonably type-safe way. This is part of a TNullable record type, which mimics, in some ways, the .NET Nullable type. The workings of this type are not all that important for the example, however. This example works with RTTI types, and with one byte non-RTTI enumerated types &mdash you’d need to extend it to support larger enumerated types. While I could reduce the number of steps in the edge case by spelunking directly into the Variant TVarData, that would not serve to clarify the murk.

constructor TNullable<T>.Create(AValue: Variant);
type
  PT = ^T;
var
  v: Byte;
begin
  if VarIsEmpty(AValue) or VarIsNull(AValue) then
    Clear
  else if (TypeInfo(T) = nil) and
    (SizeOf(T) = 1) and
    (VarType(AValue) = varByte) then
  begin
    { Assuming an enum type without typeinfo, have to
      do some cruel pointer magics here to avoid type
      cast errors, so am very careful to validate
      first! }
    v := AValue;
    FValue := PT(@v)^;
  end
  else
    Create(TValue.FromVariant(AValue).AsType<T>);
end;

So what is going on here? Well, first if we are passed Null or “Empty” variant values, then we just clear our TNullable value.

Otherwise we test if (a) we have no RTTI for our generic, and (b) it’s one byte in size, and (c) our variant is also a Byte value. If all these prerequisites are met, we perform the casting, in which we hark back to the ancient incantations with a pointer typecast, taking the address of the value and dereferencing it, fooling the compiler along the way. (Ha ha!)

Finally, we find a modern TValue incantation suffices to wreak the type change for civilised types such as Integer or String.