Svartedauen

Interface delegation test 1 v.2

Mar 22nd, 2018
447
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 4.13 KB | None | 0 0
  1. // Added TManualDelegation class that demonstrates workaround for using simple interface fields.
  2. // Fixed TAggV2 for correct memory management, eliminating memory leaks.
  3. unit Snippets.Interfaces.Delegation;
  4.  
  5. interface
  6.  
  7. uses System.SysUtils;
  8.  
  9. type
  10.   IA = interface(IInterface)
  11.     ['{F73B998B-18DA-4170-A933-92C310758818}']
  12.     function DoA: String;
  13.   end;
  14.  
  15.   IB = interface(IInterface)
  16.    ['{87AD034F-6348-4E8E-A2AB-1AAF0BD14601}']
  17.    function DoB: String;
  18.   end;
  19.  
  20.   TA = class(TInterfacedObject, IA)
  21.     function DoA: String;
  22.   end;
  23.  
  24.   TB = class(TInterfacedObject, IB)
  25.    function DoB: String;
  26.   end;
  27.  
  28.   TAggregatedA = class(TAggregatedObject, IA)
  29.     function DoA: String;
  30.   end;
  31.  
  32.   TAggregatedB = class(TAggregatedObject, IB)
  33.    function DoB: String;
  34.   end;
  35.  
  36.   TAggSimple = class(TInterfacedObject, IA, IB)
  37.   private
  38.     FA: IA;
  39.     FB: IB;
  40.   protected
  41.     property A: IA read FA implements IA;
  42.     property B: IB read FB implements IB;
  43.   public
  44.     constructor Create;
  45.   end;
  46.  
  47.   // https://stackoverflow.com/a/3483889
  48.   TAggV2 = class(TInterfacedObject, IA, IB)
  49.   private
  50.     FA: TAggregatedA;
  51.     FB: TAggregatedB;
  52.   protected
  53.     function GetA: IA;
  54.     function GetB: IB;
  55.     property A: IA read GetA implements IA;
  56.     property B: IB read GetB implements IB;
  57.   public
  58.     constructor Create;
  59.     destructor Destroy; override;
  60.   end;
  61.  
  62.   TManualDelegation = class(TInterfacedObject, IA, IB)
  63.   private
  64.     FA: IA;
  65.     FB: IB;
  66.   public
  67.     constructor Create;
  68.     function DoA: String;
  69.     function DoB: String;
  70.   end;
  71.  
  72.   TPlain = class(TInterfacedObject, IA, IB)
  73.   public
  74.     function DoA: String;
  75.     function DoB: String;
  76.   end;
  77.  
  78. function RunTest1: String;
  79.  
  80. implementation
  81.  
  82. function RunTest1: String;
  83. var
  84.   A: IA;
  85.   B: IB;
  86. begin
  87.   Result := '';
  88.   A := TAggSimple.Create;
  89.   //A.QueryInterface(IB, B);
  90.   if not Supports(A, IB, B) then
  91.     Result := 'Supports on simple aggregate (interfaced fields) failed' + #$D#$A;
  92.   Result := Result + 'TAggSimple: ' + A.DoA + #$D#$A;
  93.   if Assigned(B) then
  94.     Result := Result + 'TAggSimple: ' + B.DoB + #$D#$A;
  95.  
  96.   A := TPlain.Create;
  97.   if not Supports(A, IB, B) then
  98.     Result := 'Supports on plain failed' + #$D#$A;
  99.   Result := Result + 'TPlain: ' + A.DoA + #$D#$A;
  100.   if Assigned(B) then
  101.     Result := Result + 'TPlain: ' + B.DoB + #$D#$A;
  102.  
  103.   A := TAggV2.Create;
  104.   if not Supports(A, IB, B) then
  105.     Result := 'Supports on aggV2 failed' + #$D#$A;
  106.   Result := Result + 'TAggV2: ' + A.DoA + #$D#$A;
  107.   if Assigned(B) then
  108.     Result := Result + 'TAggV2: ' + B.DoB + #$D#$A;
  109.  
  110.   A := TManualDelegation.Create;
  111.   if not Supports(A, IB, B) then
  112.     Result := 'Supports on TManualDelegation failed' + #$D#$A;
  113.   Result := Result + 'TManualDelegation: ' + A.DoA + #$D#$A;
  114.   if Assigned(B) then
  115.     Result := Result + 'TManualDelegation: ' + B.DoB + #$D#$A;
  116. end;
  117.  
  118. { TAggSimple }
  119.  
  120. constructor TAggSimple.Create;
  121. begin
  122.   inherited;
  123.   FA := TA.Create;
  124.   FB := TB.Create;
  125. end;
  126.  
  127. { TA }
  128.  
  129. function TA.DoA: String;
  130. begin
  131.   Result := Self.ClassName + '.DoA';
  132. end;
  133.  
  134. { TB }
  135.  
  136. function TB.DoB: String;
  137. begin
  138.   Result := Self.ClassName + '.DoB';
  139. end;
  140.  
  141. { TPlain }
  142.  
  143. function TPlain.DoA: String;
  144. begin
  145.   Result := Self.ClassName + '.DoA';
  146. end;
  147.  
  148. function TPlain.DoB: String;
  149. begin
  150.   Result := Self.ClassName + '.DoB';
  151. end;
  152.  
  153. { TAggregatedA }
  154.  
  155. function TAggregatedA.DoA: String;
  156. begin
  157.   Result := Self.ClassName + '.DoA';
  158. end;
  159.  
  160. { TAggregatedB }
  161.  
  162. function TAggregatedB.DoB: String;
  163. begin
  164.   Result := Self.ClassName + '.DoB';
  165. end;
  166.  
  167. { TAggV2 }
  168.  
  169. constructor TAggV2.Create;
  170. begin
  171.   inherited;
  172.   FA := TAggregatedA.Create(Self);
  173.   FB := TAggregatedB.Create(Self);
  174. end;
  175.  
  176. destructor TAggV2.Destroy;
  177. begin
  178.   FA.Free;
  179.   FB.Free;
  180.   inherited;
  181. end;
  182.  
  183. function TAggV2.GetA: IA;
  184. begin
  185.   Result := FA;
  186. end;
  187.  
  188. function TAggV2.GetB: IB;
  189. begin
  190.   Result := FB;
  191. end;
  192.  
  193. { TManualDelegation }
  194.  
  195. constructor TManualDelegation.Create;
  196. begin
  197.   FA := TA.Create;
  198.   FB := TB.Create;
  199. end;
  200.  
  201. function TManualDelegation.DoA: String;
  202. begin
  203.   Result := FA.DoA;
  204. end;
  205.  
  206. function TManualDelegation.DoB: String;
  207. begin
  208.   Result := FB.DoB;
  209. end;
  210.  
  211. end.
Advertisement