fpc/tests/webtbs/tw7281.pp
2007-12-12 21:07:47 +00:00

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.