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.
![usa[]e](https://marc.durdin.net/wp-content/uploads/2014/03/usae.png){kind=small}
