Sign in Join

Live chat for Free Pascal, Lazarus, Delphi and every Pascal programmer.

Mailing lists / fpc-devel / 2006-06

Interfaces (long post)

1 message · 1 person ·

Reply by email Subscribe to this list Your subscription

Read-only archive. Use j and k to move between messages.

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

Reply by email