[fpc-devel] Interfaces (long post)

[Leonardo M. Ram�]

I'm trying to port a program i wrote in Delphi to
FPC & Kylix and found when an interfaced
object (COM interface, not CORBA) is instantiated 
and call the _AddRef method, in Kylix is executed
one time (as expected) but in FPC is called
two times losing the refcount. 

The correct result is this (compiled in Kylix):
--------------------
Loaded!
TMyIntfClass._AddRef
--------------------

The program compiled in FPC produces this:
--------------------
Loaded!
TMyIntfClass._AddRef
TMyIntfClass._AddRef
--------------------

By the way...
If you compile test.dpr using FPC and the library 
with Kylix (or the contrary), instead of _AddRef, 
you'll receive an AV. Anybody knows why?.

Thank's for reading this long post.

Sincerely,
Leonardo M. Ramé
Córdoba, Argentina

This is the code (I used FPC 2.0.2 & Kylix 3):
-------------------------------------------------
{ interfaces.dpr }

library interfaces;

uses
  Classes,
  intf_classes;

function KNL_GetClass(AClassName: PChar): Integer; cdecl;
(* I get pointers to classes as Integers (nice hack!) *)
begin
  Result := Integer(GetClass(AClassName));
end;

exports
  KNL_GetClass;

end.

--------------------------------------------------
{ intf_classes.pas }

unit intf_classes;

interface

uses
  Classes;

type
  IMyInterface = interface
  ['{C6785134-AF18-4FB3-8DB1-080DE6D152FC}']
  end;

  TMyIntfClass = class(TInterfacedPersistent, IMyInterface)
    private
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

implementation

function TMyIntfClass._AddRef: Integer;
begin         
  writeln('TMyIntfClass._AddRef');
  Result := -1;
end;

function TMyIntfClass._Release: Integer;
begin
  Result := -1;
end;

initialization
  (* Registramos las classes *)
  RegisterClass(TMyIntfClass);

finalization
  (* Quitamos las registrciones *)
  UnregisterClass(TMyIntfClass);
end.

--------------------------------------------------
{ test.dpr }

program test;

uses
  {$ifdef fpc}
  dynlibs,
  {$endif}
  SysUtils,
  Classes;

type
  IMyInterface = interface
  ['{C6785134-AF18-4FB3-8DB1-080DE6D152FC}']
  end;

  TMyImplementation = class(TInterfacedPersistent, IMyInterface)
  private
    FInternalObj: IMyInterface;
  public
    constructor Create;
  end;

var
  {$ifdef fpc}
  mHandle: TLibHandle;
  {$else}
  mHandle: THandle;
  {$endif}

function KNL_GetClass(AClass: string): TPersistentClass;
(* wrapper to GetClass from shared library. *)
var
  _GC: function (AClass: PChar): Integer; cdecl;
begin
  _GC := GetProcAddress(mHandle, 'KNL_GetClass');
  if (Integer(@_GC) <> 0) then
    Result := TPersistentClass(_GC(PChar(AClass)));
end;

constructor TMyImplementation.Create;
begin
  (* Here aparently calls two times _AddRef of TMyIntfClass *)
  FInternalObj := 
    TMyImplementation(KNL_GetClass('TMyIntfClass').Create) as IMyInterface;
end;

var
  myObj: TMyImplementation;

begin
  (* load shared library *)
  if (pointer(mHandle) = nil) then
  begin
    (* Try to load shared library 
       (in win32 use interfaces.dll instead of libinterfaces.so) *)
    mHandle := LoadLibrary('./libinterfaces.so');
    if (pointer(mHandle) <> nil) then
    begin
      writeln('Loaded!');
      (* instantiate a TMyImplementation object *)
      myObj := TMyImplementation.Create;
      (* Free instances *)
      myObj.Free;
      (* unload shared library *)
      {$ifdef fpc}
      UnLoadLibrary(mHandle);
      {$else}
      FreeLibrary(mHandle);
      {$endif}
    end;
  end;
end.



__________________________________________________
Do You Yahoo!?
Tired of spam?  Yahoo! Mail has the best spam protection around 
http://mail.yahoo.com