AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Object-Pascal / Delphi-Language Delphi Lock/Unlock-Mechanismus ohne Bezug auf Multithreading?

Lock/Unlock-Mechanismus ohne Bezug auf Multithreading?

Ein Thema von Der schöne Günther · begonnen am 25. Jul 2019 · letzter Beitrag vom 29. Jul 2019
Antwort Antwort
Seite 2 von 2     12
TiGü

Registriert seit: 6. Apr 2011
Ort: Berlin
2.778 Beiträge
 
Delphi 10.2 Tokyo Enterprise
 
#11

AW: Lock/Unlock-Mechanismus ohne Bezug auf Multithreading?

  Alt 25. Jul 2019, 16:22
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.
  Mit Zitat antworten Zitat
TiGü

Registriert seit: 6. Apr 2011
Ort: Berlin
2.778 Beiträge
 
Delphi 10.2 Tokyo Enterprise
 
#12

AW: Lock/Unlock-Mechanismus ohne Bezug auf Multithreading?

  Alt 26. Jul 2019, 12:05
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!
  Mit Zitat antworten Zitat
Benutzerbild von Uwe Raabe
Uwe Raabe
Online

Registriert seit: 20. Jan 2006
Ort: Lübbecke
8.451 Beiträge
 
Delphi 10.4 Sydney
 
#13

AW: Lock/Unlock-Mechanismus ohne Bezug auf Multithreading?

  Alt 26. Jul 2019, 12:12
Bist du sicher, daß der Code auch diese Forderung abdeckt?
Und dass er mir bitte "Nein" sagt wenn ich im gleichen Thread schon einmal gelocked habe.
Uwe Raabe
Certified Delphi Master Developer
Embarcadero MVP
Blog: The Art of Delphi Programming
  Mit Zitat antworten Zitat
Der schöne Günther

Registriert seit: 6. Mär 2013
5.658 Beiträge
 
Delphi 10 Seattle Enterprise
 
#14

AW: Lock/Unlock-Mechanismus ohne Bezug auf Multithreading?

  Alt 26. Jul 2019, 13:13
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;
  Mit Zitat antworten Zitat
Rollo62

Registriert seit: 15. Mär 2007
3.150 Beiträge
 
Delphi 10.4 Sydney
 
#15

AW: Lock/Unlock-Mechanismus ohne Bezug auf Multithreading?

  Alt 27. Jul 2019, 15:53
Warum nennst Du die CS mutex ?
  Mit Zitat antworten Zitat
Schokohase
(Gast)

n/a Beiträge
 
#16

AW: Lock/Unlock-Mechanismus ohne Bezug auf Multithreading?

  Alt 29. Jul 2019, 07:33
Warum nennst Du die CS mutex ?
Warum nicht? Dich darf man doch auch Mensch nennen, oder nicht?

Wikipedia: Mutex
  Mit Zitat antworten Zitat
TiGü

Registriert seit: 6. Apr 2011
Ort: Berlin
2.778 Beiträge
 
Delphi 10.2 Tokyo Enterprise
 
#17

AW: Lock/Unlock-Mechanismus ohne Bezug auf Multithreading?

  Alt 29. Jul 2019, 08:34
Bist du sicher, daß der Code auch diese Forderung abdeckt?
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;
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +2. Es ist jetzt 18:26 Uhr.
Powered by vBulletin® Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf