[fpc-pascal] Question about interfaces and patch

[ml at brainwashers.org]

Quoting Marco van de Voort <marcov at stack.nl>:

> > On Tue, 22 Mar 2005, ml wrote:
> > > // than one interface
> > >  a := (object as IA); // correct
> > >  b := (object as IB); // returns pointer to the first interface
vmt=IA
> > >  c := (object as IC); // returns pointer to the first interface
vmt=IA
> > > // there's no way to do again it's like direct call to exception
> > >  obj := a; // returns pointer(obj) + 12 ???
> > 
> > This is nonsense. You cannot assign an interface to a class.
> > A class IMPLEMENTS an interface, it is not an interface.

Ok, its nonsense. I said it already works with my patch, but I guess you
know it better. So my example down there doesn't work (with patch). You
should know.
I (; can't ;) transfer from one interface to other back to object and to
3rd interface. I just imagine my results.

> 
> Ml, see my original message. If you have an interface, you know
nothing of
> the stuff the class adds outside that interface.
> 

Wrong. 10 minutes (looking trough sources, seeing where the problem is
and implementing my patch) and everything worked.

Getting Me: TObject enables you to call all class functions. So you can
compare class compatibility or anything (directly from interface).

My implementation works ok, I was just worried a little about
implementation (I wouldn't want to break any COM interface, I'm not a
windows person and I just wanted to ask for wished approach on as and
operators and one more or less cosmetic approach, as I said I'm not
using windows and I wouldn't want to break anything). In Linux this
patch breaks nothing and adds 0 changes to previous sources that used
interfaces. The only added function Me is already solved and that's all.

But my best guess is that you're not interested in patch, anyway here it
is. All it needs now are "as" and := operators implemented correctly. I
plan to do that too, just as multiple interface inheritance (yes, it is
possible, the only problem is looking at the problem from the right
side. As long as you look at this thing as you described it, it is a no
go. If you turn around and open your eyes solution is as simple as
possible, the only problem is that you don't look at interface as you
should). If I plan correctly by the end of the weekend (it would be even
less if I would get some usable answers instead of "this doesn't work")
everything should work (I selected fpc (it has all I need, as I said I
don't mind little patches) for this job I'll be working on).

> Assigning/converting an interface to a class is impossible, which can
> be shown by this example.
> 
> Var intf : IA;           // has method C
>     cl   : SomeClass;    // has method A,B
> 
> begin
>   intf:=someclass.create;  // get reference to list with methods of
> interface
>   cl:=intf;		   // assign list with methods of interface to 
> 			   // list of methods of class.
>   cl.a;			   // cl has no knowledge about anything .c this
> 			   // can't work.		
> end;
> 
> Even though at the point of "someclass.create" all info about the
class is
> available, only a list of offsets for methods in the interface is
passed.
> (so only method C at offset 0 in that table)
> 

Yeah, heard that already, and the reason for that is that you don't
provide what is needed

> When assigning intf to cl, you assign that table back to the cl, the
full
> which needs a full VMT, with info about A and B. This makes the third
> statement
> (cl.a) impossible.
> 
> 
> _______________________________________________
> fpc-pascal maillist  -  fpc-pascal at lists.freepascal.org
> http://lists.freepascal.org/mailman/listinfo/fpc-pascal
> 

And the test source.

program project4;

{$mode objfpc}{$H+}{$MACRO+}

uses
  Classes, SysUtils, libc
  { add your units here };

type
  IA = interface
    procedure A;
    function Me: TInterfacedObject;
  end;
  
  IB = interface
    procedure B;
  end;
  
  IC = interface(IA)
    procedure C;
  end;

  ID = interface
    procedure D;
  end;
  
  TD = class(TInterfacedObject)
  end;
  
  TC = class(TD, IA, IB, IC, ID)
    constructor Create;
    destructor Destroy; override;
//    function Me: TInterfacedObject;
    procedure A;
    procedure B;
    procedure C;
    procedure D;
  end;
  
  constructor TC.Create;
  begin
    inherited Create;
    A;
    B;
    C;
  end;
  
  destructor TC.Destroy;
  begin
    Writeln('TC.Destroy');
    inherited Destroy;
  end;
  
  procedure TC.A;
  begin
    Writeln('a');
  end;

  procedure TC.B;
  begin
    Writeln('b');
  end;

  procedure TC.C;
  begin
    Writeln('c');
  end;

  procedure TC.D;
  begin
    Writeln('ddddddddddddddd');
  end;

function Equals(const source: IUnknown): TObject;
begin
  Result := source.Me;
end;

function SupportsInterface(aInterface: IUnknown; aIID: TGUID): boolean;
begin
  Result := Supports(aInterface, aIID);
end;

function SupportsInterface(aClass: TClass; aIID: TGUID): boolean;
begin
  Result := false;
  if (aClass <> nil) then
    if aClass.InheritsFrom(TInterfacedObject) then
      Result := SupportsInterface(IUnknown(aClass), aIID);
end;

procedure testD(obj: ID);
begin
  writeln('inside testD');
  if obj <> nil then
    obj.D
  else
    writeln('ua');
  if SupportsInterface(obj, ID) then
    writeln('yes')
  else
    writeln('ua');
end;

var
  c: char;
  AAAA: integer;
  t: TC;
  a: IA;
  b: IB;
  d: ID;
  t2: TC;
  cf: IUnknown;
  cc: IC;
  k: TInterfacedObject;
begin
  Writeln(SizeOf(cf));
  t := TC.Create;
  a := t;
  b := t;
  AAAA := 500;
  d := t;
  cc := t;
  a.A;
  b.B;
  writeln('t: ', integer(pointer(t)), ' --- a: ', integer(pointer(a)), '
--- b: ', integer(pointer(b)), ' --- d: ', integer(pointer(d)));
  // here as should be treated same as :=
  writeln('t: ', integer(pointer(t)), ' --- a: ', integer(pointer(t as
IA)), ' --- b: ', integer(pointer(t as IB)), ' --- d: ', integer(pointer
(t as ID)));
  t2 := TC(Equals(a));
  writeln('t2: ', integer(pointer(t2)));
  t2 := TC(Equals(cc));
  writeln('t2: ', integer(pointer(t2)));
  d := nil;
  d := t2; // if you look here I derived ID from IC, which is not
possible as you say
  d.d;
  a.A;
  b.B;
  // some junk testing code
  if (t.InheritsFrom(TD)) then
    Writeln('Inherits from TD')
  else
    Writeln('Does not Inherits from TD');
  try
    if SupportsInterface(t, IB) then
      if SupportsInterface(cc, IA) then
        if SupportsInterface(d, IB) then
          writeln('yes')
        else
          writeln('nope');
  except
    writeln('nope, error');
  end;

  writeln('testD');
  
  testD(ID(t));
  a := nil;
  b := nil;
  cc := nil;
  d := nil;
end.


----------------------------------------------------------------------
This mail sent through Horde-Toaster (http://qmailtoaster.clikka.com/)
-------------- next part --------------
A non-text attachment was scrubbed...
Name: interfaces.patch
Type: text/x-patch
Size: 1246 bytes
Desc: not available
URL: <http://lists.freepascal.org/pipermail/fpc-pascal/attachments/20050323/02dafecd/attachment.bin>