Re: [fpc-pascal] Interface, _AddRef, _Release, etc.

[Graeme Geldenhuys]

You're original problem is exactly why I said mixing class instances and
interface instance is looking for trouble. You better know what you are
doing.

Attached are two examples of your program. One using CORBA interfaces,
the other using non-reference counting COM style interface. Both work
under 64-bit FPC 2.4.5 under Linux.


[tmp]$ ./testme
foo
Done
Heap dump by heaptrc unit
20 memory blocks allocated : 599/616
20 memory blocks freed     : 599/616
0 unfreed memory blocks : 0
True heap size : 131072
True free heap : 131072


[tmp]$ ./testme_corba
foo
Done
Heap dump by heaptrc unit
20 memory blocks allocated : 599/616
20 memory blocks freed     : 599/616
0 unfreed memory blocks : 0
True heap size : 131072
True free heap : 131072




Regards,
  - Graeme -

-- 
fpGUI Toolkit - a cross-platform GUI toolkit using Free Pascal
http://fpgui.sourceforge.net/


program testme;

{$mode objfpc}{$H+}
{$interfaces corba}

uses  heaptrc,  Classes,  SysUtils;

type
  IFoo = interface
    ['{F71A4131-E0A5-48CB-B563-7BBB079D1085}']
    function GetInfo: string;
  end;
  
  TNonRefCountedObject = class(TObject, IInterface)
  private
    function QueryInterface(const iid : tguid;out obj) : longint;stdcall;
    function _AddRef : longint;stdcall;
    function _Release : longint;stdcall;
  end;

  TFoo = class(TObject, IFoo)
  private
    FInfo: string;
  protected
  public
    function GetInfo: string;
    procedure SetInfo(const AValue: string);
  end;

function TFoo.GetInfo: string;
begin
  Result := FInfo;
end;

procedure TFoo.SetInfo(const AValue: string);
begin
  FInfo := AValue;
end;

type
  TObj = class(TObject)
  public
    Foo: IFoo;
  end;


{ TNonRefCountedObject }

function TNonRefCountedObject.QueryInterface(const iid : tguid;out obj) : longint;stdcall;
begin
  if GetInterface(IID, Obj) then
    Result := S_OK
  else
    Result := E_NOINTERFACE;
end;

function TNonRefCountedObject._AddRef: longint; stdcall;
begin
  Result := -1;
end;

function TNonRefCountedObject._Release: longint; stdcall;
begin
  Result := -1;
end;



procedure Run;
var
  f: TFoo;  // << type is class, not interface
  o: TObj;
begin
  f := TFoo.Create;
  f.SetInfo('foo');
  o := TObj.Create;
  o.Foo := f;
  writeln(o.Foo.GetInfo);
  o.Free;
  f.Free;
end;

begin
  Run;
  writeln('Done');
end.

program testme_corba;

{$mode objfpc}{$H+}
{$interfaces corba}

uses  heaptrc,  Classes,  SysUtils;

type
  IFoo = interface
    ['{F71A4131-E0A5-48CB-B563-7BBB079D1085}']
    function GetInfo: string;
  end;

  TFoo = class(TObject, IFoo)
  private
    FInfo: string;
  protected
  public
    function GetInfo: string;
    procedure SetInfo(const AValue: string);
  end;

function TFoo.GetInfo: string;
begin
  Result := FInfo;
end;

procedure TFoo.SetInfo(const AValue: string);
begin
  FInfo := AValue;
end;

type
  TObj = class(TObject)
  public
    Foo: IFoo;
  end;

procedure Run;
var
  f: TFoo;  // << type is class, not interface
  o: TObj;
begin
  f := TFoo.Create;
  f.SetInfo('foo');
  o := TObj.Create;
  o.Foo := f;
  writeln(o.Foo.GetInfo);
  o.Free;
  f.Free;
end;

begin
  Run;
  writeln('Done');
end.

_______________________________________________
fpc-pascal maillist  -  fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal