Browse Source

* add TScoped for auto-destroying classes, based on an idea of Loïc Touraine

Michaël Van Canneyt 2 months ago
parent
commit
e2d58b8b94
2 changed files with 192 additions and 0 deletions
  1. 59 0
      rtl/objpas/types.pp
  2. 133 0
      tests/test/units/types/ttscoped.pp

+ 59 - 0
rtl/objpas/types.pp

@@ -514,6 +514,21 @@ type
      function Clone(out stm : IStream) : HRESULT;stdcall;
   end;
 
+  { TScoped }
+  generic TScoped<T:class> = record
+  private
+    obj: T;
+  public  
+    class operator Initialize(var hdl: TScoped);
+    class operator Finalize(var hdl: TScoped);
+    class operator :=(aObj : T) : TScoped; 
+    class operator :=(const aObj : TScoped) : T; 
+    procedure assign(aObj : T); inline;
+    function Swap(AObj: T): T;
+    function Get : T;
+  end;
+
+
 function EqualRect(const r1,r2 : TRect) : Boolean;
 function EqualRect(const r1,r2 : TRectF) : Boolean;
 function NormalizeRectF(const Pts: array of TPointF): TRectF; overload;
@@ -2052,4 +2067,48 @@ begin
   Result := TBitConverter.specialize UnsafeInTo<T>(ASource, AOffset);
 end;
 
+{ TScoped }
+
+class operator TScoped.Initialize(var hdl: TScoped);
+begin
+  hdl.obj := nil;
+end;
+
+class operator TScoped.Finalize(var hdl: TScoped);
+begin
+  hdl.obj.free;
+  hdl.obj:=nil;
+end;
+
+procedure TScoped.assign(aObj : T);
+begin
+  swap(aObj);
+end;
+
+function TScoped.Swap(AObj:T):T;
+var
+  LCurrent:T;
+begin
+  LCurrent := self.obj;
+  self.obj := AObj;
+  Result := LCurrent;
+end;
+
+function TScoped.Get() : T;
+begin
+  Result :=  self.obj;
+end;
+
+class operator TScoped.:=(aObj : T) : TScoped; 
+
+begin
+  result.assign(aObj);
+end;
+
+class operator TScoped.:=(const aObj : TScoped) : T; 
+
+begin
+  Result:=aObj.Get();
+end;
+
 end.

+ 133 - 0
tests/test/units/types/ttscoped.pp

@@ -0,0 +1,133 @@
+program ttscoped;
+
+{$mode objFPC}
+
+uses types;
+
+type
+      
+//type
+  TChildHandledObject = class
+  private
+    FStr : String;
+  public
+    class var InstanceCount : Integer;
+  public
+    constructor Create(const AStr:String);
+    destructor Destroy(); override;
+    procedure Display();
+  end;
+
+//type
+  THandledObject = class
+  private
+    FStr : String;
+    ScopedChild: specialize TScoped<TChildHandledObject>;
+  public
+    class var InstanceCount : Integer;
+  public  
+    constructor Create(const AStr:String);
+    destructor Destroy(); override;
+    procedure Display();
+  end;
+
+constructor TChildHandledObject.Create(const AStr:String);
+begin
+  FStr := AStr;
+  Inc(InstanceCount);
+end;
+
+destructor TChildHandledObject.Destroy();
+begin
+  Dec(InstanceCount);
+end;
+
+procedure TChildHandledObject.Display();
+begin
+  writeln('ChildStr = ' + FStr);
+end;
+
+constructor THandledObject.Create(const AStr:String);
+begin
+  FStr := AStr;
+  inc(InstanceCount);
+  ScopedChild.Assign(TChildHandledObject.Create('"ChildStr - ' + AStr+'"'));
+end;
+
+destructor THandledObject.Destroy();
+begin
+  Dec(InstanceCount);
+end;
+
+procedure THandledObject.Display();
+begin
+  ScopedChild.Get.Display();
+end;
+
+procedure AssertEquals(aMsg : string; aExpected,aActual : Integer);
+begin
+  if aExpected<>aActual then
+    begin
+    Writeln(aMsg,' : Expected: ',aExpected,' Actual: ',aActual);
+    Halt(1);
+    end;
+end;
+
+procedure dotestsp;
+var
+  sc: specialize TScoped<THandledObject>;
+begin
+  AssertEquals('Initial THandledObject',0,THandledObject.InstanceCount);
+  AssertEquals('Initial TChileHandledObject',0,TChildHandledObject.InstanceCount);
+  sc.Assign(THandledObject.Create('Hello'));
+  AssertEquals('Created THandledObject',1,THandledObject.InstanceCount);
+  AssertEquals('Created TChildHandledObject',1,TChildHandledObject.InstanceCount);
+  sc.Get().Display();
+end;  
+
+procedure dotestspassign;
+var
+  sc: specialize TScoped<THandledObject>;
+begin
+  AssertEquals('Initial THandledObject',0,THandledObject.InstanceCount);
+  AssertEquals('Initial TChileHandledObject',0,TChildHandledObject.InstanceCount);
+  sc:=THandledObject.Create('Hello');
+  AssertEquals('Created THandledObject',1,THandledObject.InstanceCount);
+  AssertEquals('Created TChildHandledObject',1,TChildHandledObject.InstanceCount);
+  sc.Get().Display();
+end;  
+
+procedure dotestspassignto;
+var
+  sc: specialize TScoped<THandledObject>;
+  v : THandledObject;
+begin
+  AssertEquals('Initial THandledObject',0,THandledObject.InstanceCount);
+  AssertEquals('Initial TChileHandledObject',0,TChildHandledObject.InstanceCount);
+  sc.assign(THandledObject.Create('Hello'));
+  AssertEquals('Created THandledObject',1,THandledObject.InstanceCount);
+  AssertEquals('Created TChildHandledObject',1,TChildHandledObject.InstanceCount);
+  v:=sc;
+  AssertEquals('Assigned THandledObject',1,THandledObject.InstanceCount);
+  AssertEquals('Assigned TChildHandledObject',1,TChildHandledObject.InstanceCount);
+  v.display;
+  AssertEquals('Displayed THandledObject',1,THandledObject.InstanceCount);
+  AssertEquals('Displayed TChildHandledObject',1,TChildHandledObject.InstanceCount);
+end;  
+
+begin
+  Writeln('Simple');
+  dotestsp;
+  AssertEquals('Final THandledObject',0,THandledObject.InstanceCount);
+  AssertEquals('Final TChileHandledObject',0,TChildHandledObject.InstanceCount);
+  Writeln('Assign');
+  dotestspassign;
+  AssertEquals('Final THandledObject',0,THandledObject.InstanceCount);
+  AssertEquals('Final TChileHandledObject',0,TChildHandledObject.InstanceCount);
+  Writeln('Assign to');
+  dotestspassignto;
+  AssertEquals('Final THandledObject',0,THandledObject.InstanceCount);
+  AssertEquals('Final TChileHandledObject',0,TChildHandledObject.InstanceCount);
+end.
+
+