Lock/Unlock-Mechanismus ohne Bezug auf Multithreading?

[Der schöne Günther]

Vielen Dank für die Mühe.

Ich habe Angst vor dem Gepointere - Du fütterst TMonitor mit einem von außen übergebenen Pointer, der erwartet aber TObject. Ich hätte spontan eine Interface-Referenz reingesteckt ☠

Ich zeige mal was ich draus gemacht habe:

Definition, Implementation & Tests @ Gist.Github.com

Im Endeffekt ist es das hier:

Delphi-Quellcode:

type
   ILockableResourceControl = interface
   ['{21971BDB-F68E-483E-9324-0CA924EE14CE}']
      procedure UnRegisterLock(const lock: ILock);
   end;

   TLockableResource = class(TInterfacedObject, ILockableResource, ILockableResourceControl)
      private type
         /// <summary>
         ///     Use raw pointers to circumvent reference counting
         /// </summary>
         {$If CompilerVersion >= 31}{$Message 'Consider [Weak] attribute'}{$EndIf}
         PLock = ^ILock;
      private var
         mutex: TCriticalSection;
         currentLockPointer: PLock;
         lockAvailableEvent: TEvent;
      protected
         function getCurrentLock(): ILock;
      public
         constructor Create();
         destructor Destroy(); override;
         procedure UnregisterLock(const lock: ILock);
         function TryLock(out lock: ILock): Boolean; overload;
         function TryLock(out lock: ILock; const timeout: TTimeSpan): Boolean; overload;
   end;

sowie

Delphi-Quellcode:

implementation uses
  System.SysUtils,
  System.Classes,
  System.Threading;

{ TLockableResource }

constructor TLockableResource.Create();
begin
   inherited Create();
   mutex := TCriticalSection.Create();
   lockAvailableEvent := TSimpleEvent.Create();
end;

destructor TLockableResource.Destroy();
begin
   mutex.Acquire();
   if Assigned(getCurrentLock()) then
      getCurrentLock().UnLock();
   lockAvailableEvent.Free();
   mutex.Free();
   inherited;
end;

function TLockableResource.getCurrentLock(): ILock;
begin
   Result := ILock(currentLockPointer);
end;

function TLockableResource.TryLock(out lock: ILock): Boolean;
begin
   mutex.Acquire();
   try
      if Assigned(getCurrentLock()) then
         Result := False
      else
         begin
            lock := TLock.Create(self);
            currentLockPointer := PLock(lock);
            Result := True;
            end;
   finally
      mutex.Release();
    end;
end;

function TLockableResource.tryLock(
   out lock: ILock;
   const timeout: TTimeSpan): Boolean;
var
   future: IFuture<ILock>;
begin
   future := TTask.Future<ILock>(
      function(): ILock
      begin
         while not TryLock(Result) do
            begin
               lockAvailableEvent.WaitFor();
               TTask.CurrentTask().CheckCanceled();
            end;
      end
   );
   Result := future.Wait(timeout);
   if Result then
      lock := future.Value
   else
      future.Cancel();
end;

procedure TLockableResource.UnregisterLock(const lock: ILock);
begin
   mutex.Acquire();
   try
      if (lock <> getCurrentLock()) then
         raise ELockException.Create(String.Empty);
      currentLockPointer := nil;
      lockAvailableEvent.SetEvent();
   finally
      mutex.Release();
    end;
end;