mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-15 05:49:12 +02:00
* new bug
git-svn-id: trunk@4745 -
This commit is contained in:
parent
367958e154
commit
0445dc039e
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -7336,6 +7336,7 @@ tests/webtbs/tw7161.pp svneol=native#text/plain
|
|||||||
tests/webtbs/tw7195.pp svneol=native#text/plain
|
tests/webtbs/tw7195.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw7227.pp svneol=native#text/plain
|
tests/webtbs/tw7227.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw7276.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/tw7329.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw7372.pp svneol=native#text/plain
|
tests/webtbs/tw7372.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw7379.pp svneol=native#text/plain
|
tests/webtbs/tw7379.pp svneol=native#text/plain
|
||||||
|
66
tests/webtbs/tw7281.pp
Executable file
66
tests/webtbs/tw7281.pp
Executable 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.
|
||||||
|
|
Loading…
Reference in New Issue
Block a user