* TLockGuard, based on an idea by Loïc Touraine

packages/fcl-base/examples/README.txt

@@ -80,4 +80,5 @@ contit.pp    Test/Demo for iterators in contnr.pp
 csvbom.pp    Test/Demo for BOM detection in CSV document. (needs databom.txt)
 testappexit.pp Test/Demo for TApplication exit code handling. (ExitCode and ExceptionExitcode)
 demoio.pp    Demo for AssignStream from streamio unit.
-testthreadpool  Demo for fpthreadpool unit.
+testthreadpool  Demo for fpthreadpool unit.
+demolg       TLockGuard demo.

packages/fcl-base/examples/demolg.pp

@@ -0,0 +1,125 @@
+program testlg;
+
+{$mode objFPC}
+{$modeswitch advancedrecords}
+
+Uses
+  {$ifdef unix}
+  cthreads,
+  {$endif}
+  sysutils,
+  classes,
+  syncobjs;
+
+type
+
+  { TLockGuard }
+  generic TLockGuard<T:TSynchroObject> = record
+    obj: T;
+    class operator Initialize(var hdl: TLockGuard);
+    class operator Finalize(var hdl: TLockGuard);
+    procedure Init(AObj: T); 
+  end;
+
+class operator TLockGuard.Initialize(var hdl: TLockGuard);
+begin
+  hdl.obj := nil;
+end;
+
+class operator TLockGuard.Finalize(var hdl: TLockGuard);
+begin
+  if (hdl.obj=nil) then
+    exit;
+  hdl.obj.Release();
+end;
+
+procedure TLockGuard.Init(AObj:T);
+begin
+  self.obj := AObj;
+  self.obj.Acquire();
+end;
+
+Function Fibonacci(TN,N : Integer) : Int64;
+Var
+  Next,Last : Int64;
+  I : Integer;
+
+begin
+  if N=0 then
+    exit(0);
+  Result:=1;
+  Last:=0;
+  for I:=1 to N-1 do
+    begin
+    Next:=Result+last;
+    Last:=Result;
+    Result:=Next;
+    Writeln('Thread['+IntToStr(TN)+'] '+IntToStr(Result));
+    end;
+end;
+
+var
+  ThreadCount : Integer;
+  ExecuteCount : Integer;
+
+Type
+  { TCalcThread }
+  TCalcThread = Class(TThread)
+  Public
+    class var ExecuteLock : TCriticalSection;
+  Private
+    FNo : Integer;
+  Public  
+    constructor create(aNo : Integer);
+    destructor destroy; override;
+    Procedure Execute; override;
+    
+  end;
+
+{ TCalcThread }
+
+constructor TCalcThread.create(aNo : Integer);
+begin
+  Inherited Create(False);
+  InterlockedIncrement(ThreadCount);
+  FNo:=aNo;
+  Writeln('Creating thread ',FNo);
+  FreeOnTerminate:=True;
+end;
+
+destructor TCalcThread.destroy; 
+begin
+  InterlockedDecrement(ThreadCount);
+  Inherited;
+end;
+
+procedure TCalcThread.Execute;
+var
+  lock : specialize TLockGuard<TCriticalSection>;
+  Res : Integer;
+begin
+  lock.Init(ExecuteLock);
+  InterlockedIncrement(ExecuteCount);
+  if ExecuteCount<>1 then 
+    Writeln('Error : multiple threads are executing (start)');
+  Res:=Fibonacci(FNo,10);
+  writeln('Thread['+IntTostr(FNo),'] Fibonacci(10) = '+IntToStr(Res));
+  InterlockedDecrement(ExecuteCount);
+  if ExecuteCount<>0 then 
+    Writeln('Error : multiple threads are executing (stop)');
+end;
+
+var
+  I : integer;
+begin
+  TCalcThread.ExecuteLock:=TCriticalSection.Create;
+  for I:=1 to 10 do
+    TCalcThread.Create(i); 
+  repeat
+    sleep(10);
+    CheckSynchronize;
+  until (ThreadCount=0);
+    
+end.
+
+

packages/fcl-base/src/syncobjs.pp

@@ -12,6 +12,7 @@
 
  **********************************************************************}
 {$mode objfpc}
+{$modeswitch advancedrecords}
 {$h+}
 
 {$IF DEFINED(WINCE) or DEFINED(AIX)}
@@ -75,6 +76,14 @@ type
       procedure Release;virtual;
    end;
 
+   { TLockGuard }
+   generic TLockGuard<T:TSynchroObject> = record
+     obj: T;
+     class operator Initialize(var hdl: TLockGuard);
+     class operator Finalize(var hdl: TLockGuard);
+     procedure Init(AObj: T); 
+   end;
+
    TCriticalSection = class(TSynchroObject)
    private
       CriticalSection : TRTLCriticalSection;
@@ -87,6 +96,8 @@ type
       constructor Create;
       destructor Destroy;override;
    end;
+   TCriticalSectionGuard = specialize TLockGuard<TCriticalSection>;
+
    THandleObject= class;
    THandleObjectArray = array of THandleObject;
 
@@ -192,6 +203,7 @@ type
      function Release(aCount: Integer): Integer; reintroduce; overload;
      function WaitFor(aTimeout: Cardinal = INFINITE): TWaitResult; override;
    end;
+   TSemaphoreGuard = specialize TLockGuard<TSemaphore>;
 {$ENDIF}
 
 {$IFNDEF NO_MUTEX_SUPPORT}
@@ -209,10 +221,9 @@ type
     procedure Acquire; override;
     procedure Release; override;
   end;
+  TMutexGuard = specialize TLockGuard<TMutex>;
 {$ENDIF}
 
-
-
 implementation
 
 {$ifdef MSWindows}
@@ -1007,4 +1018,25 @@ begin
 end;
 {$ENDIF NO_MUTEX_SUPPORT}
 
+{ TLockGuard }
+
+class operator TLockGuard.Initialize(var hdl: TLockGuard);
+begin
+  hdl.obj := nil;
+end;
+
+class operator TLockGuard.Finalize(var hdl: TLockGuard);
+begin
+  if (hdl.obj=nil) then
+    exit;
+  hdl.obj.Release();
+end;
+
+procedure TLockGuard.Init(AObj:T);
+begin
+  self.obj := AObj;
+  self.obj.Acquire();
+end;
+
+
 end.