Why Gemfury? Push, build, and install  RubyGems npm packages Python packages Maven artifacts PHP packages Go Modules Debian packages RPM packages NuGet packages

Repository URL to install this package:

Details    
fpc-src / usr / share / fpcsrc / 3.2.0 / tests / webtbs / tw7281.pp
Size: Mime:
program test_intf;

{$mode objfpc}{$H+}

uses
  SysUtils;

type
  ITest = interface
    ['{7B7E58C4-6E23-4414-8EB2-CA81023348DE}']
    procedure DoIt(AMsg : string);
  end;

  { TTest }

  TTest = class(TInterfacedObject,ITest)
  protected
    procedure DoIt(AMsg : string);
  public
    constructor Create();
    destructor Destroy();override;
  end;

var InstancesCount : Integer = 0;

{ TTest }

procedure TTest.DoIt(AMsg: string);
begin
  WriteLn(AMsg);
end;

constructor TTest.Create();
begin
  Inherited;
  Inc(InstancesCount);
  WriteLn('Creating >>> ',HexStr(PtrUInt(self),sizeof(PtrUInt)*2));
end;

destructor TTest.Destroy();
begin
  Dec(InstancesCount);
  WriteLn('Destroying >>> ',HexStr(PtrUInt(self),sizeof(PtrUInt)*2));
  inherited Destroy();
end;

procedure proc1(ATest : ITest);
begin
  ATest.DoIt('  called in proc1');
end;

procedure test();
begin
  (TTest.Create() as ITest).DoIt('  called in test');
  proc1(TTest.Create() as ITest);
  proc1(TTest.Create() as ITest);
  proc1(TTest.Create() as ITest);
  proc1(TTest.Create() as ITest);
end;

begin
  test();
  WriteLn('Remaining instances ... ',InstancesCount);
  if InstancesCount<>0 then
    halt(1);
end.