Lock/Unlock-Mechanismus ohne Bezug auf Multithreading?

[Der schöne Günther]

Ich suche etwas wo man Zugriff auf eine geschützte Resource anfordern kann, und wenn man Zugriff bekommt danach die Sperre wieder frei machen muss.

Alles was ich finde (kritische Abschnitte, Semaphore, Monitor, …) liegt in System oder System.SyncObjs, bezieht sich aber auf Threads. Bei all diesen Implementationen meint er es gut einen Deadlock zu verhindern indem man problemlos sagen kann:

Delphi-Quellcode:

someMutex.Acquire();
someMutex.Acquire();
ShowMessage('Das hier sollte nie zu sehen sein');

Ich suche etwas wo ich sagen kann "TryLock" und er sagt mir "ja/nein". Und dass er mir bitte "Nein" sagt wenn ich im gleichen Thread schon einmal gelocked habe.

Gibt es da etwas in der Standard-Bibliothek? Ich finde nichts.

[Uwe Raabe]

Das ist jetzt vermutlich zu trivial:

Delphi-Quellcode:

type
  TLock = record
  private
    FLocked: Boolean;
    class function Create: TLock; static;
  public
    function TryLock: Boolean;
    procedure Unlock;
    property Locked: Boolean read FLocked;
  end;

class function TLock.Create: TLock;
begin
  Result.FLocked := False;
end;

function TLock.TryLock: Boolean;
begin
  Result := not FLocked;
  FLocked := True;
end;

procedure TLock.Unlock;
begin
  FLocked := False;
end;

[Der schöne Günther]

Ja schon ein bisschen 😉
Das ist ja im Endeffekt wie eine globale Boolean-Variable an die jeder dran darf. Ich hätte mir schon vorgestellt dass man es nur unlocken kann wenn man es selbst vorher gelocked hat.

Wenn es nichts gibt bastele ich mir etwas und frage nach Feedback sobald ich fertig bin. Auf die Schnelle kenne ich in den Bibliotheken anderer Sprachen auch nichts...

[Neutral General]

Zitat:

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

Ich hätte mir schon vorgestellt dass man es nur unlocken kann wenn man es selbst vorher gelocked hat.

Wenn sich alles in einem Thread abspielt ist alles/jeder "man selbst". Wie definierst du dieses "selbst"?
Im Prinzip müsstest du dem Lock() einen (zufälligen?) Wert übergeben den nur die Methode die das Lock() aufgerufen hat lokal kennt und der dann quasi als eine Art "Password" für das Unlock() fungiert.

Also Uwe's Klasse erweitert:

Delphi-Quellcode:

type
  TLock = record
  private
    FLocked: Boolean;
    FPW: Integer;
    class function Create: TLock; static;
  public
    function TryLock(APW: Integer): Boolean;
    function Unlock(APW: Integer): Boolean;
    property Locked: Boolean read FLocked;
  end;

class function TLock.Create: TLock;
begin
  Result.FLocked := False;
end;

function TLock.TryLock(APW: Integer): Boolean;
begin
  Result := not FLocked;
  if (Result) then
  begin
    FLocked := True;
    FPW := APW;
  end;
end;

procedure TLock.Unlock(APW: Integer);
begin
  Result := APW = FPW;
  if Result then
    FLocked := False;
end;

Edit: Uwe's Erweiterung unten ist sogar noch einen Tick eleganter
V
V

[Uwe Raabe]

Zitat:

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

dass man es nur unlocken kann wenn man es selbst vorher gelocked hat.

Wer ist denn selbst bzw. wie identifiziert sich dieses selbst? Man kann sich natürlich beim Lock auch einen Syhlüssel zum Unlock geben lassen:

Delphi-Quellcode:

  TLock = record
  private
    FLocked: TGUID;
    class function Create: TLock; static;
    function GetLocked: Boolean;
  public
    function TryLock(var Key: TGUID): Boolean;
    function Unlock(const Key: TGUID): Boolean;
    property Locked: Boolean read GetLocked;
  end;

class function TLock.Create: TLock;
begin
  Result.FLocked := TGUID.Empty;
end;

function TLock.GetLocked: Boolean;
begin
  Result := (FLocked <> TGUID.Empty);
end;

function TLock.Unlock(const Key: TGUID): Boolean;
begin
  Result := False;
  if Key = FLocked then begin
    FLocked := TGUID.Empty;
    Result := True;
  end;
end;

function TLock.TryLock(var Key: TGUID): Boolean;
begin
  Result := False;
  if not Locked then begin
    Key := TGUID.NewGuid;
    FLocked := Key;
    Result := True;
  end;
end;

Das scheint aber schon eine sehr spezielle Anforderung zu sein, die du da umsetzen willst.

Ich sehe gerade, da hat das schon jemand aufgegriffen. :thumb:

[Der schöne Günther]

Zitat:

Zitat von Neutral General (Beitrag 1437634)

Wenn sich alles in einem Thread abspielt

Das habe ich nicht gesagt. Multithreading-fähig muss das natürlich schon sein.

Zitat:

Zitat von Neutral General (Beitrag 1437634)

Im Prinzip müsstest du dem Lock() einen (zufälligen?) Wert übergeben den nur die Methode die das Lock() aufgerufen hat lokal kennt und der dann quasi als eine Art "Password" für das Unlock() fungiert.

Zitat:

Zitat von Uwe Raabe (Beitrag 1437637)

Man kann sich natürlich beim Lock auch einen Syhlüssel zum Unlock geben lassen

Richtig, nur dass ich keine GUID oder Integer nehmen würde sondern eine Interface-basierte Referenz die dafür sorgt dass spätestens dann Unlock() gemacht wird wenn man die Referenz wegwirft und man vergessen hat aufzuschließen.


Ich denke im Groben habe ich jetzt auch etwas, das Interface ist ungefähr so:

Delphi-Quellcode:

   ELockException = class(Exception);
   ELockNotHeldException = class(ELockException);

   ILock = interface
   ['{57CCCDE4-63F8-41F6-A6F0-39B4159B06FF}']
      /// <exception cref="ELockNotHeldException" />
      procedure UnLock();
   end;

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

[Uwe Raabe]

Zitat:

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

Ich suche etwas wo man Zugriff auf eine geschützte Resource anfordern kann, und wenn man Zugriff bekommt danach die Sperre wieder frei machen muss.

Zitat:

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

Ich suche etwas wo ich sagen kann "TryLock" und er sagt mir "ja/nein". Und dass er mir bitte "Nein" sagt wenn ich im gleichen Thread schon einmal gelocked habe.

Zitat:

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

Ich hätte mir schon vorgestellt dass man es nur unlocken kann wenn man es selbst vorher gelocked hat.

Zitat:

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

Multithreading-fähig muss das natürlich schon sein.

Zitat:

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

die dafür sorgt dass spätestens dann Unlock() gemacht wird wenn man die Referenz wegwirft und man vergessen hat aufzuschließen.

Deine Spezifikationen vermehren sich mit jedem Post :-D

[Der schöne Günther]

Stimmt :oops:

Ich glaube es ist Zeit für eine Pause 🏖 🍧

[einbeliebigername]

Hallo,

bevor du was selbst programmierst, erkläre noch mal an einem Beispile was du brauchst. Denn wenn du in einem Thread

Delphi-Quellcode:

  x.Acquire;
  try
    x.Acquire;
    try
      Do;
    finally
      x.Release;
    end;
  finally
    x.Release;
  end;

hast, kann er doch nur entweder das

Delphi-Quellcode:

Do

ausführen oder den Thread für immer blockieren.

Es gibt bei einigen noch ein

Delphi-Quellcode:

function TryEnter: Boolean

. Vieleicht hilft das.

[Uwe Raabe]

Zitat:

Zitat von einbeliebigername (Beitrag 1437643)

Es gibt bei einigen noch ein

Delphi-Quellcode:

function TryEnter: Boolean

. Vieleicht hilft das.

Das TryEnter läuft aber positiv durch, wenn es mehrfach im selben Thread aufgerufen wird. Das widerspricht einer Anforderung.

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