Re: Sugestion to Multiple Inheritance

["Matthew Heaney" <mheaney@on2.com>]

"Lutz Donnerhacke" <lutz@iks-jena.de> wrote in message
news:slrna3tf3u.kg.lutz@taranis.iks-jena.de...
>  I have an several (at least two) interfaces with must be implemented
>  by the end user (compiler should require implementation). All of them
>  build a free(!) depedency tree. The simplest one is:
>
>      A -> B     B is an extended A and C is an extended A.
>      |    |     D combines both extensions (requiring both).
>      v    v
>      C -> D

You have to declare two "interface" types, B and C:

package P is
   type AType is abstract tagged limited null record;
   procedure A_Op (A : access AType) is abstract;

  type BType is abstract new A with null record;
  procedure B_Op (B : access BType) is abstract;
  type BAccess is access all BType'Class;

  type CType is abstract new A with null record;
  procedure C_Op (C : access CType) is abstract;
  type CAccess is access all CType'Class;
end P;

Now you want a D that you can view as either a B or a C:

with P; use P;
package Q is

  type DType is limited private;

  function BView (D : access DType) return BAccess;
  function CView (D : access DType) return CAccess;

private

  type D_BType (D : access DType) is new P.BType with null record;
  procedure A_Op (BPart : access D_BType);
  procedure B_Op (BPart : access D_BType);

  type D_CType (D : access DType) is new P.CType with null record;
  procedure A_Op (CPart : access D_CType);
  procedure C_Op (CPart : access D_CType);

  type DType is
     limited record
        BPart : aliased D_BType (DType'Access);
       CPart : aliased D_CType (DType'Access);
    end record;
end Q;

package body Q is
   function BView (D : access DType) return BAccess is
   begin
      return D.BPart'Access;
   end;

   function CView (D : access DType) return CAccess is
   begin
      return D.CPart'Access;
   end;

end Q;

Now you can use a D wherever you need a B or C, for example:

procedure Some_Op (B : access P.BType'Class);

declare
   D : aliased DTYpe;
begin
   Some_Op (BView (D'Access));
end;