mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-05 14:48:18 +02:00
68 lines
1.2 KiB
ObjectPascal
68 lines
1.2 KiB
ObjectPascal
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.
|
|
|