View Issue Details

IDProjectCategoryView StatusLast Update
0016531FPCCompilerpublic2013-03-25 14:48
ReporterMartin SchreiberAssigned To 
PrioritynormalSeverityminorReproducibilityalways
Status newResolutionopen 
Product Version2.5.1Product Build 
Target VersionFixed in Version 
Summary0016531: Partial interface delegation to class
DescriptionPartial interface delegation to class not possible.
Test result Delphi 7:
"
test
test1
"

Compile result FPC trunk:
"
Free Pascal Compiler version 2.5.1 [2010/05/21] for i386
Copyright (c) 1993-2009 by Florian Klaempfl
Target OS: Win32 for i386
Compiling delegation.pas
delegation.pas(22,54) Error: Class "timpclass" does not implement interface "itest"
delegation.pas(35,1) Error: No matching implementation for interface method "itest.test;" found
delegation.pas(88) Fatal: There were 2 errors compiling module, stopping
Fatal: Compilation aborted
"
Tagsimplements, interface
Fixed in Revision
FPCOldBugId
FPCTarget
Attached Files
  • delegation.pas (1,431 bytes)
    program delegation;
    {$ifdef FPC}{$mode objfpc}{$h+}{$endif}
    {$ifdef mswindows}{$apptype console}{$endif}
    uses
     sysutils;
    //{$interfaces corba}
    
    type
     itest = interface
      procedure test;
      procedure test1;
     end;
     
     timpclass = class(tobject)
      protected
       procedure test;
     end;
     
     ttestclass = class(tobject,itest)
      private
       fimp: timpclass;
       property imp: timpclass read fimp implements itest;
      protected
       function _addref: integer; stdcall;
       function _release: integer; stdcall;
       function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;   
       procedure test1;
      public
       constructor create;
       destructor destroy; override;
     end;
    
    { timpclass }
    
    procedure timpclass.test;
    begin
     writeln('test');
    end;
    
    { ttestclass }
    
    constructor ttestclass.create;
    begin
     fimp:= timpclass.create;
    end;
    
    destructor ttestclass.destroy;
    begin
     inherited;
     fimp.free;
    end;
    
    function ttestclass._addref: integer; stdcall;
    begin
     result:= -1;
    end;
    
    function ttestclass._release: integer;  stdcall;
    begin
     result:= -1;
    end;
    
    function ttestclass.QueryInterface(const IID: TGUID; out Obj): HResult;  stdcall;
    begin
     if GetInterface(IID, Obj) then begin
       Result:=0
     end
     else begin
      result:= integer(e_nointerface);
     end;
    end;
    
    procedure ttestclass.test1;
    begin
     writeln('test1');
    end;
    
    var
     testclass: ttestclass;
    begin
     testclass:= ttestclass.create;
     itest(testclass).test;
     itest(testclass).test1;
    
     testclass.free;
    end.
    
    
    delegation.pas (1,431 bytes)

Relationships

related to 0023403 new Interface delegate class - incompatible with Delphi 
child of 0008951 assignedIvo Steinmann FPC doesn't allow implements properties be of class types 

Activities

2010-05-21 19:19

 

delegation.pas (1,431 bytes)
program delegation;
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
{$ifdef mswindows}{$apptype console}{$endif}
uses
 sysutils;
//{$interfaces corba}

type
 itest = interface
  procedure test;
  procedure test1;
 end;
 
 timpclass = class(tobject)
  protected
   procedure test;
 end;
 
 ttestclass = class(tobject,itest)
  private
   fimp: timpclass;
   property imp: timpclass read fimp implements itest;
  protected
   function _addref: integer; stdcall;
   function _release: integer; stdcall;
   function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;   
   procedure test1;
  public
   constructor create;
   destructor destroy; override;
 end;

{ timpclass }

procedure timpclass.test;
begin
 writeln('test');
end;

{ ttestclass }

constructor ttestclass.create;
begin
 fimp:= timpclass.create;
end;

destructor ttestclass.destroy;
begin
 inherited;
 fimp.free;
end;

function ttestclass._addref: integer; stdcall;
begin
 result:= -1;
end;

function ttestclass._release: integer;  stdcall;
begin
 result:= -1;
end;

function ttestclass.QueryInterface(const IID: TGUID; out Obj): HResult;  stdcall;
begin
 if GetInterface(IID, Obj) then begin
   Result:=0
 end
 else begin
  result:= integer(e_nointerface);
 end;
end;

procedure ttestclass.test1;
begin
 writeln('test1');
end;

var
 testclass: ttestclass;
begin
 testclass:= ttestclass.create;
 itest(testclass).test;
 itest(testclass).test1;

 testclass.free;
end.

delegation.pas (1,431 bytes)

Jonas Maebe

2010-05-21 19:58

manager   ~0037848

Sergei Gorelkin today also mentioned it on the mailing list: http://lists.freepascal.org/lists/fpc-devel/2010-May/020109.html

In general, FPC's delegation support is still very rough.

Sergei Gorelkin

2010-05-22 12:46

developer   ~0037860

In Delphi, such 'partial' delegation is the only possible kind of delegation to the class. IOW, if the delegate class implements the interface by itself, that interface is totally unrelated to the delegated one.

Marco van de Voort

2012-01-04 13:01

manager   ~0055468

Currently yields an exception:

D:\testing>fpc ll.dpr
Free Pascal Compiler version 2.7.1 [2012/01/02] for i386
Copyright (c) 1993-2011 by Florian Klaempfl and others
Target OS: Win32 for i386
Compiling ll.dpr
ll.dpr(22,54) Error: Class "timpclass" does not implement interface "itest"
Fatal: Compilation aborted
An unhandled exception occurred at $00511EC1:
EAccessViolation: Access violation
  $00511EC1 TVMTBUILDER__IS_NEW_VMT_ENTRY, line 284 of nobj.pas
  $0051372D TVMTBUILDER__GENERATE_VMT, line 768 of nobj.pas
  $004FA9F2 TYPES_DEC, line 700 of pdecl.pas
  $004FAC33 TYPE_DEC, line 760 of pdecl.pas
  $004F424C READ_DECLARATIONS, line 1811 of psub.pas
  $004F0C11 BLOCK, line 169 of psub.pas
  $004F3552 TCGPROCINFO__PARSE_BODY, line 1412 of psub.pas
  $00541766 PROC_PROGRAM, line 2269 of pmodules.pas
  $00438970 COMPILE, line 403 of parser.pas
  $0041618D COMPILE, line 252 of compiler.pas
  $00401866 main, line 228 of pp.pas

Issue History

Date Modified Username Field Change
2010-05-21 19:19 Martin Schreiber New Issue
2010-05-21 19:19 Martin Schreiber File Added: delegation.pas
2010-05-21 19:58 Jonas Maebe Note Added: 0037848
2010-05-22 12:15 Sergei Gorelkin Tag Attached: implements
2010-05-22 12:15 Sergei Gorelkin Tag Attached: interface
2010-05-22 12:46 Sergei Gorelkin Note Added: 0037860
2012-01-04 13:01 Marco van de Voort Note Added: 0055468
2012-01-04 15:53 Marco van de Voort Relationship added child of 0008951
2012-11-29 05:28 Sergei Gorelkin Relationship added related to 0023403