Skip to content

Instantly share code, notes, and snippets.

@jpluimers

jpluimers/LockableConsoleProject.dpr Secret

Last active Apr 21, 2019
Embed
What would you like to do?
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 …
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.
//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.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.