Delphi Correct Method for Thread Safe Class Use

In Delphi what is the correct method when using a class as a data container? We are trying to analyze a problem that shows up periodically (something like 1 in 10^9 executions). The example code below illustrates the threading model. The referenced callbacks are used to allow various functions to alter the functionality dynamically based on some criteria. In the code below, note the assignment in UpdateValueEvent() where we perform the D := D_Local assignment to return the value to the thread. We do this since Delphi says it cannot capture the variable D in the callback - so I assume we are doing something to circumvent a warning - thus we believe this is the issue... any guidance is greatly appreciated.

unit main;

interface

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

type
 TDataContainer = class
 private
  FSomeValue: byte;
 public
  constructor Create;
  property SomeValue: byte read FSomeValue write FSomeValue;
 end;

 TMethodCallback = reference to procedure(Value: byte; var NewValue: byte);

 TDataWorker = class
 private
  function GetNewData(
   Value: byte;
   var D: TDataContainer
   ): boolean;
 public
  function UpdateDataStore(
   Value: byte;
   CallbackA: TMethodCallback;
   callbackB: TMethodCallback
   ): boolean;
 end;

 TUpdateEvent = procedure(Sender: TObject; Value: byte; var D: TDataContainer) of object;

 TWorkerThread = class(TThread)
 private
  FSeed: byte;
  // events
  FOnUpdate: TUpdateEvent;
 protected
  procedure Execute; override;
 public
  constructor Create;
  // events
  property OnUpdate: TUpdateEvent read FOnUpdate write FOnUpdate;
 end;

 TForm1 = class(TForm)
  btnTest: TButton;
  procedure btnTestClick(Sender: TObject);
 private
  FRunningThreads: integer;
  FDataWorker: TDataWorker;
  FWorkerThread1: TWorkerThread;
  FWorkerThread2: TWorkerThread;
  // private event handlers
  procedure UpdateValueEvent(Sender: TObject; AValue: byte; var D: TDataContainer);
  procedure TerminateEvent(Sender: TObject);

 public
  // public stuff
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

{ TDataContainer }

constructor TDataContainer.Create;
begin
 FSomeValue := 0;
end;

{ TWorkerThread }

constructor TWorkerThread.Create;
begin
 inherited Create(true); // create suspended
 FreeOnTerminate := true;
 FSeed := $02;
end;

procedure TWorkerThread.Execute;
var
 Value: byte;
 bit_value: byte;
 passes: integer;
 D: TDataContainer;
 successful_accesses: integer;
begin
 successful_accesses := 0;
 FSeed := $02;
 Value := FSeed;
 passes := 100000;
 repeat
  // simple PRBS7 sequence to provide monotonic random numbers
  //
  bit_value := ((Value SHR 6) xor (Value SHR 5)) and $01;
  Value := ((Value shl 1) or bit_value) and $7F;
  if (Value = FSeed) then
   dec(passes);
  // initialize call
  D := nil; // <-- this is how we pass data back to the calling thread - via a data container class
  // make the call to emulate how data is passed back to the calling thread
  if Assigned(FOnUpdate) then
   FOnUpdate(self, Value, D); // <-- if the call is successful, D is assigned and contains valid data, else D = nil
  if Assigned(D) then
   begin
    inc(successful_accesses);
    FreeAndNil(D);
   end;
 until (passes = 0);
end;

{ TDataWorker }

function TDataWorker.GetNewData(Value: byte; var D: TDataContainer): boolean;
begin
 // this emulates the FindObject function which emulates an SQL call
 // create a new container, and place the value in it...
 // ...equivalent to always finding something in the database table
 D := TDataContainer.Create;
 D.SomeValue := Value xor $FF; // equivalent to parsing the query results
 Result := true;               // true when the query successfully completed
end;

function TDataWorker.UpdateDataStore(Value: byte; CallbackA, callbackB: TMethodCallback): boolean;
var
 NewValueA: byte;
 NewValueB: byte;
begin
 // this is pretty close to what we are trying to do...
 Result := false;
 if not Assigned(CallbackA) or not Assigned(callbackB) then
  exit;
 // emulate the first callback
 CallbackA(Value, NewValueA);
 // emulate the second callback
 callbackB(NewValueA, NewValueB);
 // set the return state if successful
 Result := Value = NewValueB;
end;

{ Form1 }

procedure TForm1.btnTestClick(Sender: TObject);
begin
 btnTest.Enabled := false;
 cursor := crAppStart;
 FRunningThreads := 0;
 // create a data worker object
 FDataWorker := TDataWorker.Create;
 try
  // create two worker threads and use the same update handler
  // (emulates our situation)
  FWorkerThread1 := TWorkerThread.Create;
  FWorkerThread1.OnUpdate := UpdateValueEvent;
  FWorkerThread1.OnTerminate := TerminateEvent;
  FWorkerThread2 := TWorkerThread.Create;
  FWorkerThread2.OnUpdate := UpdateValueEvent;
  FWorkerThread2.OnTerminate := TerminateEvent;
  // both workers will try to execute UpdateValueEvent as fast as possible
  // without serialization - no critical section
  FWorkerThread1.Start;
  inc(FRunningThreads);
  FWorkerThread2.Start;
  inc(FRunningThreads);

  // wait until the threads complete
  while (FRunningThreads > 0) do
   Application.ProcessMessages;
 finally
  FDataWorker.Free;
  cursor := crDefault;
  btnTest.Enabled := true;
 end;
end;

procedure TForm1.TerminateEvent(Sender: TObject);
begin
 dec(FRunningThreads);
end;

procedure TForm1.UpdateValueEvent(Sender: TObject; AValue: byte; var D: TDataContainer);
var
 D_Local: TDataContainer;
begin
 if not Assigned(FDataWorker) then
  exit;

 // make the call to update the values
 if FDataWorker.UpdateDataStore(
  // input value
  AValue,
  // callback A
  procedure(Value: byte; var NewValue: byte)
  begin
   // in our production code, this works with a local data container object (like this)
   if FDataWorker.GetNewData(Value, D_Local) and Assigned(D_Local) then
    begin
     NewValue := D_Local.SomeValue;
     FreeAndNil(D_Local);
    end
   else
    NewValue := Value;
  end,
 // callback B
  procedure(Value: byte; var NewValue: byte)
  begin
   if FDataWorker.GetNewData(Value, D_Local) and Assigned(D_Local) then
    NewValue := D_Local.SomeValue
   else
    NewValue := Value;
  end
  ) then
  begin
   // if this is successful, we pass the data object back like this:
   D := D_Local;
   // THIS FAILS (VERY) PERIODICALLY in our production code.  Can this assignment
   // be made safely when multiple threads are calling this function?  If not, why?
  end;
end;

end.
How many English words
do you know?
Test your English vocabulary size, and measure
how many words do you know
Online Test
Powered by Examplum