paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 13:09:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* new bug

Browse Source 
git-svn-id: trunk@4745 -
This commit is contained in:
peter 2006-09-28 07:31:12 +00:00
parent 367958e154
commit 0445dc039e
2 changed files with 67 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -7336,6 +7336,7 @@ tests/webtbs/tw7161.pp svneol=native#text/plain
tests/webtbs/tw7195.pp svneol=native#text/plain
tests/webtbs/tw7227.pp svneol=native#text/plain
tests/webtbs/tw7276.pp svneol=native#text/plain
tests/webtbs/tw7281.pp svneol=native#text/plain
tests/webtbs/tw7329.pp svneol=native#text/plain
tests/webtbs/tw7372.pp svneol=native#text/plain
tests/webtbs/tw7379.pp svneol=native#text/plain

66
tests/webtbs/tw7281.pp Executable file
View File

@ -0,0 +1,66 @@
program test_intf;
{$mode objfpc}{$H+}
uses
SysUtils;
type
ITest = interface
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.