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,
	T_FILL_THIS_FORM_SHORT autolearn=ham autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,1116ece181be1aea
X-Google-Attributes: gid103376,public
X-Google-ArrivalTime: 2003-09-15 08:09:43 PST
Path: archiver1.google.com!postnews1.google.com!not-for-mail
From: mheaney@on2.com (Matthew Heaney)
Newsgroups: comp.lang.ada
Subject: Re: Is the Writing on the Wall for Ada?
Date: 15 Sep 2003 08:09:42 -0700
Organization: http://groups.google.com/
Message-ID: <1ec946d1.0309150709.4a7daa12@posting.google.com>
References: <eh78b.7499$ej1.4404@nwrdny01.gnilink.net>
 <AAb8b.320778$cF.97371@rwcrnsc53> <3F615341.4000100@attbi.com>
 <568ede3c.0309121211.743a8da2@posting.google.com>
NNTP-Posting-Host: 66.162.65.162
Content-Type: text/plain; charset=ISO-8859-1
Content-Transfer-Encoding: 8bit
X-Trace: posting.google.com 1063638583 14077 127.0.0.1 (15 Sep 2003 15:09:43
 GMT)
X-Complaints-To: groups-abuse@google.com
NNTP-Posting-Date: 15 Sep 2003 15:09:43 GMT
Xref: archiver1.google.com comp.lang.ada:42526
Date: 2003-09-15T15:09:43+00:00
List-Id: <comp.lang.ada>

hyrosen@mail.com (Hyman Rosen) wrote in message news:<568ede3c.0309121211.743a8da2@posting.google.com>...
> "Robert I. Eachus" <rieachus@attbi.com> wrote in message news:<3F615341.4000100@attbi.com>...
> > There is no way to directly inherit from two 
> > classes, unless one is a subclass of the other.
> 
> I am well an truly puzzled at this remark.
> Let me give a C++ example, and you can tell me why you don't believe it.

Here's the Ada95 version of your example:

package Colorable_Types is
   
   type Root_Colorable_Type is
      abstract tagged limited null record;
      
   type Colorable_Class_Access is
      access all Root_Colorable_Type'Class;
      
   procedure Set_Color 
     (Colorable : access Root_Colorable_Type;
      Color     : in     Integer) is abstract;
   
   function Get_Color (Colorable : access Root_Colorable_Type)
      return Integer is abstract;
      
end Colorable_Types;


package Colorable_Types.Adapters is

   type Colorable_Adapter_Type is
      new Root_Colorable_Type with private;
      
   procedure Set_Color 
     (Colorable : access Colorable_Adapter_Type;
      Color     : in     Integer);
   
   function Get_Color (Colorable : access Colorable_Adapter_Type)
      return Integer;
      
private


   type Colorable_Adapter_Type is
      new Root_Colorable_Type with record
         Color : Integer;
      end record;
      
end Colorable_Types.Adapters;


package Resizable_Types is

   type Root_Resizable_Type is
      abstract tagged limited null record;
      
   type Resizable_Class_Access is
      access all Root_Resizable_Type'Class;
      
   procedure Set_Size
     (Resizable : access Root_Resizable_Type;
      Size      : in     Float) is abstract;
      
   function Get_Size (Resizable : access Root_Resizable_Type) 
     return Float is abstract;
     
end Resizable_Types;


package Resizable_Types.Adapters is

   type Resizable_Adapter_Type is
      new Root_Resizable_Type with private;
      
   procedure Set_Size
     (Resizable : access Resizable_Adapter_Type;
      Size      : in     Float);
      
   function Get_Size (Resizable : access Resizable_Adapter_Type) 
     return Float;
     
private

   type Resizable_Adapter_Type is
      new Root_Resizable_Type with record
         Size : Float;
      end record;
     
end Resizable_Types.Adapters;

with Colorable_Types.Adapters; use Colorable_Types;
with Resizable_Types.Adapters; use Resizable_Types;

package My_Objects is

   type My_Object is limited private;
   
   function Colorable (Object : access My_Object)
      return Colorable_Class_Access;
      
   function Resizable (Object : access My_Object)
      return Resizable_Class_Access;
      
   procedure Do_Something (Object : in out My_Object);
   
private

   use Colorable_Types.Adapters;
   use Resizable_Types.Adapters;

   type Colorable_View (Object : access My_Object) is
      new Colorable_Adapter_Type with null record;
      
   type Resizable_View (Ojbect : access My_Object) is
      new Resizable_Adapter_Type with null record;
 
   type My_Object is limited record
      Colorable : aliased Colorable_View (My_Object'Access);
      Resizable : aliased Resizable_View (My_Object'Access);
   end record;
   
end My_Objects;

Now you can do this:

procedure Test_MI is

   Obj : aliased My_Object;
   
begin

   Set_Color (Colorable (Obj'Access), Color => 0);
   Set_Size (Resizable (Obj'Access), Size => 1.0);

   Do_Something (Obj);
   
end Test_MI;

The type My_Object "inherits" from both Colorable and Resizable. 
Anywhere you have subprogram that accepts a Colorable or Resizable,
you can use a My_Object.