[Solved] Nutzung von Interfaces

[Scotty]

Ich habe mal ein kleines Beispiel gebaut:

Code: Alles auswählen

program Project1;
 
uses Classes;
 
type
 
  {$interfaces CORBA}
 
  ITest=interface
    function GetText: string;
    property Text:string read GetText;
    procedure Free;
  end;
 
  TATest=class(TComponent,ITest)
    function GetText: string;
  end;
 
  TBTest=class(TComponent,ITest)
    function GetText: string;
  end;
 
function TATest.GetText: string;
begin
  Result:='TATest.Test';
end;
 
function TBTest.GetText: string;
begin
  Result:='TBTest.Test';
end;
 
var
  MyTest:iTest;
 
begin
  MyTest:=TATest.Create(nil);
  writeln(MyTest.Text);
  MyTest.Free;    //ohne meldet heaptrc fehler
//  if (MyTest is TATest) then; //geht nicht mit CORBA
  if TATest(MyTest).Tag=1 then;
 
  MyTest:=TBTest.Create(nil);
  writeln(MyTest.Text);
  MyTest.Free;   //ohne meldet heaptrc fehler
end.
 

Ohne Free bleibt was im Speicher hängen, bei CORBA geht "is" nicht - aber da habe ich eben eine Lösung gefunden.

[mse]

Aha, deine Klasse stammt von TComponent ab. TComponent ignoriert die automatische Lebenszeitbestimmung durch COM interface:

Code: Alles auswählen

 
function TComponent._AddRef: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
  if Assigned(VCLComObject) then
    Result := IVCLComObject(VCLComObject)._AddRef
  else
    Result := -1;
end;
 
function TComponent._Release: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
  if Assigned(VCLComObject) then
    Result := IVCLComObject(VCLComObject)._Release
  else
    Result := -1;
end;
 
 

im Gegensatz dazu TInterfacedObject:

Code: Alles auswählen

 
    function TInterfacedObject._AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 
      begin
         _addref:=interlockedincrement(frefcount);
      end;
 
    function TInterfacedObject._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 
      begin
         _Release:=interlockeddecrement(frefcount);
         if _Release=0 then
           self.destroy;
      end;
 

Die Kombination von COM interface mit TComponent führt unter FPC häufig zu Problemen wegen dem erwähnten Effekt der versteckten Zwischenvariablen, ist aber auch unter Delphi nicht wirklich wasserdicht.
Edit:
Wie Marco schreibt, weiter vorne erwähnt und auch aus der FPC-Dokumentation ersichtlich, sind CORBA interface nicht referenzgezählt und destroy() (oder free) muss auf jeden Fall aufgerufen werden. Bei TComponent geschieht dies möglicherweise auch durch owner.

[marcov]

Das ist das Problem nicht.

iTest ist einfachweg ein Corba interface, also nicht ref-counted, und wird nicht automatisch gereleased.

Lösung: Entferne $Interfaces corba

[mse]

Das ist das Problem nicht.

iTest ist einfachweg ein Corba interface, also nicht ref-counted, und wird nicht automatisch gereleased.

Schon, weiter vorne verwendet Scotty aber COM interface und hatte dabei ein memory leak. Dies wäre auch bei diesem Testfall mit COM interface ohne free der Fall weil ja TComponent _release() ignoriert.

[Scotty]

Meine Klassen hängen an TCustomDrawGrid und "TGLContext" was wiederum direkt von TOpenGLControl abgeleitet ist. Wenn mich nicht alles täuscht, dann sind die wiederum mit TComponent verwandt. Ich habe in dem Beispiel TComponent genommen, damit ich überhaupt COM benutzen kann. Das führt dann im Beispiel zum Speicherleck, auch wenn ich die Objekte free'e. Mit corba klappt es, allerdings habe ich noch keine Lösung für das typecasting gefunden. In dem beschränkten Beispiel geht etwas in der Art:

Code: Alles auswählen

  if TATest(MyTest).Tag=1 then
    TATest(MyTest).Doit; 

...in meinem Code geht das nicht. Dort verteilt sich der Code auf verschiedene Units, wobei ich überall "interfaces corba" angeben kann und das noch nicht hilft. Ich werde als nächstes versuchen, die Routinen einfach alle ins Interface aufzunehmen und eine Helperklasse zu erstellen ("interface delegation"). Ich hoffe, dass das ähnlich wie abstrakte Methoden funktionieren wird.

[mse]

Richtig, typecasten von einem CORBA interface zu der implementierenden Klasseninstanz geht nicht.
Füge für diesen Zweck eine Funktion im interface hinzu:

Code: Alles auswählen

 
  {$interfaces CORBA}
 
  ITest=interface
    function getinstance: tcomponent;
    function GetText: string;
    property Text:string read GetText;
    procedure Free;
  end;
 
  TATest=class(TComponent,ITest)
    function getinstance: tcomponent;
    function GetText: string;
  end;
 
  TBTest=class(TComponent,ITest)
    function getinstance: tcomponent;
    function GetText: string;
  end;
 
function TATest.getinstance: tcomponent;
begin
 result:= self;
end;
 
function TBTest.getinstance: tcomponent;
begin
 result:= self;
end;
 
[...]
 
 with TATest(MyTest.getinstance) do begin
  if Tag=1 then begin
   Doit;
  end;
 end;
 

[Scotty]

Code: Alles auswählen

 {$interfaces CORBA}
  ITest=interface
    function getinstance: tcomponent;
...
  with TATest(MyTest.getinstance) do

Coole Lösung! Ich probiers heute Abend aus.

[Scotty]

Klappt einwandfrei! Ich kann hin und her switchen - kein Fehler. Und am Ende liefert heaptrc

Code: Alles auswählen

Heap dump by heaptrc unit
1237830 memory blocks allocated : 124174141/128579336
1237830 memory blocks freed     : 124174141/128579336
0 unfreed memory blocks : 0
True heap size : 1867776
True free heap : 1866880
Should be : 1867776
An unhandled exception occurred at $00000000004ABFA4 :
EAccessViolation : 
  $00000000004ABFA4
 

(Wegen der Exception nach Beendigung mache ich einen neuen Thread auf.)