From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham
	autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,34c2aa33b8bdb1a9
X-Google-Attributes: gid103376,public
X-Google-ArrivalTime: 2002-01-11 14:00:25 PST
Path: 
 archiver1.google.com!news1.google.com!newsfeed.stanford.edu!logbridge.uoregon.edu!news.maxwell.syr.edu!sn-xit-03!sn-post-02!sn-post-01!supernews.com!corp.supernews.com!not-for-mail
From: "Matthew Heaney" <mheaney@on2.com>
Newsgroups: comp.lang.ada
Subject: Re: Sugestion to Multiple Inheritance
Date: Fri, 11 Jan 2002 17:04:39 -0500
Organization: Posted via Supernews, http://www.supernews.com
Message-ID: <u3uo3b4r4oft6a@corp.supernews.com>
References: <slrna3tf3u.kg.lutz@taranis.iks-jena.de>
X-Priority: 3
X-MSMail-Priority: Normal
X-Newsreader: Microsoft Outlook Express 5.50.4807.1700
X-MimeOLE: Produced By Microsoft MimeOLE V5.50.4807.1700
X-Complaints-To: newsabuse@supernews.com
Xref: archiver1.google.com comp.lang.ada:18800
Date: 2002-01-11T17:04:39-05:00
List-Id: <comp.lang.ada>


"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;