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

[Marcos Douglas]

Hi,

A class (TFoo) implements an interface (IFoo), but my class has more
methods and properties (in the eg below just one more method) that I
need use.

Another object has a property of IFoo type.
So, I created a Foo and assigns my object property.

>From this moment I can not longer release my Foo object, because the refcount.

See (attention in the comments below):

program p1;

{$ifdef FPC}
  {$mode objfpc}{$H+}
{$else}
  {$apptype console}
{$endif}

uses  heaptrc,  Classes,  SysUtils;

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

  TFoo = class(TInterfacedObject, 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; // << I can't use it because it already was freed
end;

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

BUT, if I create my TFoo without refcount should works, right?
So, I change my class:

  TFoo = class(TObject, IFoo)
  private
    FInfo: string;
  protected
    function QueryInterface(const iid : tguid;out obj) : longint;stdcall;
    function _AddRef : longint;stdcall;
    function _Release : longint;stdcall;
  public
    function GetInfo: string;
    procedure SetInfo(const AValue: string);
  end;

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

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

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

... but, does not work. In Delphi 7 yes, but no in FPC.

See this http://bugs.freepascal.org/view.php?id=15526

Do you think this is right?

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