Bläddra i källkod

* new bug

git-svn-id: trunk@4745 -
peter 19 år sedan
förälder
incheckning
0445dc039e
2 ändrade filer med 67 tillägg och 0 borttagningar
  1. 1 0
      .gitattributes
  2. 66 0
      tests/webtbs/tw7281.pp

+ 1 - 0
.gitattributes

@@ -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 - 0
tests/webtbs/tw7281.pp

@@ -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.
+