ILockable/TLockable/Lockable. Similar to IManaged in Spring4D, but provides a Locked interface. Note this is very inefficient, but can be practical as a shotgun approach to start solving the mess when you inherit a project that has the "I know, I’ll use threads!" approach in it. Replace the resource typed TNeedsLock that needs protection with a …

LockableConsoleProject.dpr

program LockableConsoleProject;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  FastMM4,
  System.SysUtils,
  System.Threading,
  LockableUnit in '..\..\..\Library\RTL\Generics\LockableUnit.pas';

type
  TContainer = class(TObject)
  strict private
    fContext: string;
    fCheck: Integer;
  public
    constructor Create(const aContext: string);
    destructor Destroy; override;
    procedure Logic(const aIndex: Integer);
  end;

constructor TContainer.Create(const aContext: string);
begin
  inherited Create();
  fCheck := 0;
  fContext := aContext;
  Writeln('TContainer.Create for ', fContext);
end;

destructor TContainer.Destroy;
begin
  Writeln('TContainer.Destory for ', fContext);
  inherited Destroy();
end;

procedure TContainer.Logic(const aIndex: Integer);
begin
  Inc(fCheck);
  Sleep(1);
  Dec(fCheck);
  Assert(fCheck = 0);
  Write(aIndex, ' ');
end;

///////////////////////// Example showing global ILockable<TContainer> (which gets released upon application finalization)

var
  gLockable: ILockable<TContainer>;

procedure Iteration(aIndex: Integer);
var
  lLocked: ILocked<TContainer>;
  lLockedObject: TContainer;
begin
  lLocked := gLockable.Locked(); // maintains lLocked reference to the end of the scope (in our case: end of the method)
  lLockedObject := lLocked(); // gets the locked TContainer instance out of lLocked.
  lLockedObject.Logic(aIndex);
end;

procedure RunIterations();
const
  MinIndex = 1;
  MaxIndex = 100;
var
  lIndex: Integer;
begin
  // single-threaded check: prints MinIndex..MaxIndex in order
  for lIndex := MinIndex to MaxIndex do
    Iteration(lIndex);
  Writeln;

  // multi-threaded check: prints MinIndex..MaxIndex in "random" order depending on thread scheduling artefacts
  // There are many overloads of &For; we use this one:
  //     class function &For(ALowInclusive, AHighInclusive: Integer; const AIteratorEvent: TProc<Integer>): TLoopResult; overload; static; inline;
  TParallel.&For(MinIndex, MaxIndex, Iteration);
  Writeln;
end;

procedure DemonstrateGlobalLockable();
begin
  gLockable := Lockable.New(TContainer.Create('DemonstrateGlobalLockable'));

  RunIterations();
end;

///////////////////////// Example showing local ILockable<TContainer> (which gets released upon container finalization)

type
  TContext = class
  strict private
    fLockable: ILockable<TContainer>;
    procedure Iteration(aIndex: Integer);
    procedure RunIterations();
  public
    constructor Create(const aLockable: ILockable<TContainer>);
    class procedure Run(const aLockable: ILockable<TContainer>);
  end;

constructor TContext.Create(const aLockable: ILockable<TContainer>);
begin
  inherited Create();
  fLockable := aLockable;
end;

procedure TContext.Iteration(aIndex: Integer);
var
  lLocked: ILocked<TContainer>;
  lLockedObject: TContainer;
begin
  lLocked := fLockable.Locked(); // maintains lLocked reference to the end of the scope (in our case: end of the method)
  lLockedObject := lLocked(); // gets the locked TContainer instance out of lLocked.
  lLockedObject.Logic(aIndex);
end;

procedure TContext.RunIterations();
const
  MinIndex = 1;
  MaxIndex = 100;
var
  lIndex: Integer;
begin
  // single-threaded check: prints MinIndex..MaxIndex in order
  for lIndex := MinIndex to MaxIndex do
    Iteration(lIndex);
  Writeln;

  // multi-threaded check: prints MinIndex..MaxIndex in "random" order depending on thread scheduling artefacts
  // There are many overloads of &For; we use this one:
  //     class function &For(ALowInclusive, AHighInclusive: Integer; const AIteratorEvent: TProc<Integer>): TLoopResult; overload; static; inline;
  TParallel.&For(MinIndex, MaxIndex, Iteration);
  Writeln;
end;

class procedure TContext.Run(const aLockable: ILockable<TContainer>);
var
  lContext: TContext;
begin
  lContext := TContext.Create(aLockable);
  try
    lContext.RunIterations();
  finally
    lContext.Free();
  end;
end;

procedure DemonstrateLocalLockable();
var
  lLockable: ILockable<TContainer>;
begin
  lLockable := Lockable.New(TContainer.Create('DemonstrateLocalLockable'));
  try
    TContext.Run(lLockable);
  finally
    lLockable := nil;
  end;
end;

///////////////////////// Main program

begin
  Writeln('Main block: begin');
  try
    DemonstrateGlobalLockable(); // note gLockable is finalized in the finalization of the application when reference counts to global variables are released.
    DemonstrateLocalLockable(); // note Instance.fLockable is finalized when Instance.Destroy runs: a far more deterministic place than a global variable.
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Writeln('Main block: end');
end.

LockableUnit.pas

//1 Similar to ManagedTManaged/IManaged in Spring4D, but with an extra Lockable/TLockable/ILockable layer providing a Locked method
/// Note this is very inefficient, but can be practical as a shotgun approach to
/// start solving the mess when you inherit a project that has the "I know, I’ll
/// use threads!" approach in it.
///
/// A more performant, but less versatile example from Stefan Glienke is at https://bitbucket.org/snippets/sglienke/8KLXzn

unit LockableUnit;

interface

type
  ILocked<T: class> = reference to function: T;

  TLocked<T: class> = class(TInterfacedObject, ILocked<T>)
  private
    fValue: T;
    function Invoke: T; inline;
  public
    constructor Create(const value: T); overload;
    destructor Destroy; override;
  end;

  Locked = record
  public
    class function New<T: class>(const value: T): ILocked<T>; static;
  end;

  /// Replace the resource typed TNeedsLock that needs protection with a
  /// ILockable<TNeedsLock>, then route all references via a call to the Locked()()
  /// call to it.
  ILockable<TNeedsLock: class> = interface
    //1 Until the resulting ILocked<TNeedsLock> gets out of scope, it will be locked using a TMonitor.Enter on the TNeedsLock reference
    function Locked(): ILocked<TNeedsLock>;
  end;

  TLockable<TNeedsLock: class> = class(TInterfacedObject, ILockable<TNeedsLock>)
  strict private
    fValue: TNeedsLock;
  private
    function Locked(): ILocked<TNeedsLock>;
  public
    constructor Create(const value: TNeedsLock); overload;
    destructor Destroy; override;
  end;

  Lockable = record
  public
    class function New<TNeedsLock: class>(const value: TNeedsLock): ILockable<TNeedsLock>; static;
  end;

implementation

{ TLocked }

constructor TLocked<T>.Create(const value: T);
begin
  inherited Create();
  fValue := value;
  TMonitor.Enter(fValue);
end;

destructor TLocked<T>.Destroy;
begin
  TMonitor.Exit(fValue);
  inherited Destroy();
end;

function TLocked<T>.Invoke: T;
begin
  Result := fValue;
end;

class function Locked.New<T>(const value: T): ILocked<T>;
begin
  Result := TLocked<T>.Create(value);
end;

{ TLockable }

constructor TLockable<TNeedsLock>.Create(const value: TNeedsLock);
begin
  inherited Create;
  fValue := value;
end;

destructor TLockable<TNeedsLock>.Destroy();
begin
  fValue.Free();
  fValue := nil;
  inherited Destroy();
end;

function TLockable<TNeedsLock>.Locked(): ILocked<TNeedsLock>;
begin
  Result := LockableUnit.Locked.New<TNeedsLock>(fValue);
end;

class function Lockable.New<TNeedsLock>(const value: TNeedsLock): ILockable<TNeedsLock>;
begin
  Result := TLockable<TNeedsLock>.Create(value);
end;

end.