utils/tests/uTestHelper.pas

unit uTestHelper;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, TestFramework;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TIntfObjOwner = class(TTestCase)
  private
    fIntfObjCounter: Integer;

  protected
    procedure SetUp; override;

  public
    property IntfObjCounter: Integer read fIntfObjCounter;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TIntfObj = class(TObject, IUnknown)
  private
    fOwner: TIntfObjOwner;

  private { IUnknown }
    fRefCount : longint;
    function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};

  public
    constructor Create(const aOwner: TIntfObjOwner);
    destructor Destroy; override;
  end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TIntfObjOwner/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TIntfObjOwner.SetUp;
begin
  inherited SetUp;
  fIntfObjCounter := 0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TIntfObj//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TIntfObj.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
  if getinterface(iid,obj)
    then result := S_OK
    else result := longint(E_NOINTERFACE);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TIntfObj._AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
  _addref := InterLockedIncrement(fRefCount);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TIntfObj._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
  _Release := InterLockedDecrement(fRefCount);
  if (_Release = 0) then
    Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TIntfObj.Create(const aOwner: TIntfObjOwner);
begin
  inherited Create;
  fOwner := aOwner;
  inc(fOwner.fIntfObjCounter);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TIntfObj.Destroy;
begin
  dec(fOwner.fIntfObjCounter);
  inherited Destroy;
end;

end.