Lock/Unlock-Mechanismus ohne Bezug auf Multithreading?

[TiGü]

Wrappe doch einfach einen TMonitor (oder mach dir nen Helper dran) und übergebe dir im Enter/TryEnter den Pointer der aktuellen Instanz. Darauf machst du auch das Enter des TMonitors.
Wenn der nächste Aufrufer wieder die gleiche Instanz ist, dann geht das, aber eine andere darf nicht.
Nur so ins Blaue geschrieben, ungetestet.

[TiGü]

Delphi-Quellcode:

program LockWithInstance;

{$APPTYPE CONSOLE}

{$R *.res}

uses
    System.SysUtils,
    System.Timespan,
    System.SyncObjs;

type
    ELockException = class(Exception);
    ELockNotHeldException = class(ELockException);
    TInstance = Pointer;

    ILock = interface
        ['{57CCCDE4-63F8-41F6-A6F0-39B4159B06FF}']
        function Lock(const AInstance: TInstance; ATimeout: Cardinal = 0): Boolean;
        /// <exception cref="ELockNotHeldException" />
        procedure UnLock(const AInstance: TInstance);
    end;

    ILockableResource = interface
        ['{88085418-BD27-4B5D-AD00-B456C8E017A7}']
        function TryLock(
          const AInstance: TInstance;
          out lock: ILock;
          const timeout: TTimeSpan
          ): Boolean; overload;
        function TryLock(const AInstance: TInstance; out lock: ILock): Boolean; overload;
    end;

    TLock = class(TInterfacedObject, ILock)
    strict private
        FInstance: TInstance;
    public
        constructor Create;
        function Lock(const AInstance: TInstance; ATimeout: Cardinal = 0): Boolean;
        procedure UnLock(const AInstance: TInstance);

    end;

    TLockableResource = class(TInterfacedObject, ILockableResource)
    strict private
        FLock: ILock;
    public
        constructor Create();
        function TryLock(
          const AInstance: TInstance;
          out lock: ILock;
          const timeout: TTimeSpan
          ): Boolean; overload;
        function TryLock(const AInstance: TInstance; out lock: ILock): Boolean; overload;
    end;

constructor TLock.Create;
begin
    inherited Create;
end;

function TLock.Lock(const AInstance: TInstance; ATimeout: Cardinal = 0): Boolean;
begin
    if FInstance = nil then
    begin
        FInstance := AInstance;
        Result := TMonitor.Enter(FInstance, ATimeout);
    end
    else
        raise ELockException.Create('This is a different instance!');
end;

procedure TLock.UnLock(const AInstance: TInstance);
begin
    if AInstance = FInstance then
    begin
        TMonitor.Exit(AInstance);
    end
    else
        raise ELockNotHeldException.Create('This instance is not holding the lock!');

end;

{ TLockableResource }

function TLockableResource.TryLock(const AInstance: TInstance; out lock: ILock; const timeout: TTimeSpan): Boolean;
begin
    lock := FLock;
    Result := lock.Lock(AInstance);
end;

constructor TLockableResource.Create;
begin
    FLock := TLock.Create
end;

function TLockableResource.TryLock(const AInstance: TInstance; out lock: ILock): Boolean;
begin
    lock := FLock;
    Result := lock.Lock(AInstance);
end;

procedure Test1;
var
    A, B: TObject;
    LockableResource: ILockableResource;
    Lock: ILock;
begin
    A := TObject.Create;
    B := TObject.Create;
    LockableResource := TLockableResource.Create;

    LockableResource.TryLock(A, Lock);
    Lock.unlock(B);
    LockableResource.TryLock(B, Lock);

    B.Free;
    A.Free;
end;

procedure Test2;
var
    A, B: TObject;
    LockableResource: ILockableResource;
    Lock: ILock;
begin
    A := TObject.Create;
    B := TObject.Create;
    LockableResource := TLockableResource.Create;

    LockableResource.TryLock(A, Lock);
    LockableResource.TryLock(B, Lock);

    B.Free;
    A.Free;
end;

begin
    try
        Test1;
    except
        on E: Exception do
            Writeln(E.ClassName, ': ', E.Message);
    end;

    try
        Test2;
    except
        on E: Exception do
            Writeln(E.ClassName, ': ', E.Message);
    end;
    Readln;

end.

So!

[Uwe Raabe]

Zitat:

Zitat von TiGü (Beitrag 1437714)

So!

Bist du sicher, daß der Code auch diese Forderung abdeckt?

Zitat:

Zitat von Der schöne Günther (Beitrag 1437619)

Und dass er mir bitte "Nein" sagt wenn ich im gleichen Thread schon einmal gelocked habe.

[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;

[Rollo62]

Warum nennst Du die CS mutex ?

[Schokohase]

Zitat:

Zitat von Rollo62 (Beitrag 1437796)

Warum nennst Du die CS mutex ?

Warum nicht? Dich darf man doch auch Mensch nennen, oder nicht?

Wikipedia: Mutex

[TiGü]

Zitat:

Zitat von Uwe Raabe (Beitrag 1437716)

Zitat:

Zitat von TiGü (Beitrag 1437714)

So!

Bist du sicher, daß der Code auch diese Forderung abdeckt?

Zitat:

Zitat von Der schöne Günther (Beitrag 1437619)

Und dass er mir bitte "Nein" sagt wenn ich im gleichen Thread schon einmal gelocked habe.

Nur wenn man an alle Fälle denkt und die ausprogrammiert und das nicht übermüdet zwischen zwei Arbeitsaufgaben hin skizziert!

Delphi-Quellcode:

function TLock.Lock(const AInstance: TInstance; ATimeout: Cardinal = 0): Boolean;
begin
    Result := False;
    if AInstance <> nil then
    begin
        if FInstance = nil then
        begin
            FInstance := AInstance;
            Result := TMonitor.Enter(FInstance, ATimeout);
        end
        else if FInstance <> AInstance then
        begin
            raise ELockException.Create('This is a different instance!');
        end
        else
            Result := True;
    end;
end;