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,616091a85ff150f1
X-Google-Attributes: gid103376,public
X-Google-ArrivalTime: 2001-12-04 10:39:34 PST
Path: 
 archiver1.google.com!news1.google.com!sn-xit-02!sn-post-01!supernews.com!corp.supernews.com!not-for-mail
From: "Matthew Heaney" <mheaney@on2.com>
Newsgroups: comp.lang.ada
Subject: Re: Ada 200X Assertions
Date: Tue, 4 Dec 2001 13:43:24 -0500
Organization: Posted via Supernews, http://www.supernews.com
Message-ID: <u0q6368mkken84@corp.supernews.com>
References: <3C0C48BE.3B20F04E@adaworks.com>
 <slrna0p3q9.n1.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:17392
Date: 2001-12-04T13:43:24-05:00
List-Id: <comp.lang.ada>


"Lutz Donnerhacke" <lutz@iks-jena.de> wrote in message
news:slrna0p3q9.n1.lutz@taranis.iks-jena.de...
> * Richard Riehle wrote:
> Problem 1: Pointer of component => Pointer to aggregate
>
>   In order to mixin a generic list with head nodes not mixed into any
other
>   user defined structure I'd need to link not the base data but the mixin
>   itself. Doing so I need to regenerate the whole aggregate pointer from
>   a pointer of a component. Current (not tested) implementation:
[snip]
>    It's clearly a workaround to fix a missing language feature. Even other
>    solutions (i.e. using Base'Size) are only workarounds which may fail in
>    complex situations (pragma Pack) even more likely.
>
>    Of course this Conversion may return a Pointer to an invalid aggregate.

What on Earth are you trying to do here?  Of course the language already
allows you to move from a pointer to component to a pointer to aggregate:
just use an access discriminant.

In the code below, List_Item behavior is "mixed in" with objects of type T,
allowing T objects to be inserted into List_Type objects.

All you need are access discriminants.  No Chapter 13 trickery is needed to
make this work.  It is completely safe.

Access discriminants are your friend.  If you're not using them, then you
haven't really groked the Ada95 way of doing things.


--STX
package body Lists is

   procedure Push
     (List : in out List_Type;
      Item : access List_Item_Type'Class) is
   begin
      Item.Next := List.Head;
      Item.Prev := null;
      List.Head := List_Item_Class_Access (Item);
   end;

   procedure Iterate (List : in out List_Type) is
      Item : List_Item_Class_Access := List.Head;
   begin
      while Item /= null loop
         Process (Item);
         Item := Item.Next;
      end loop;
   end;

end Lists;
package Lists is
   type List_Type is limited private;

   type List_Item_Type is abstract tagged limited private;
   type List_Item_Class_Access is access all List_Item_Type'Class;
   for List_Item_Class_Access'Storage_Size use 0;

   procedure Push
     (List : in out List_Type;
      Item : access List_Item_Type'Class);

   procedure Process (Item : access List_Item_Type) is abstract;

   procedure Iterate (List : in out List_Type);


private

   type List_Item_Type is abstract tagged limited record
      Next, Prev : List_Item_Class_Access;
   end record;

   type List_Type is limited record
      Head : List_Item_Class_Access;
   end record;

end Lists;

   with Ada.Text_IO; use Ada.Text_IO;

package body P is
   function List_Item (O : access T) return List_Item_Class_Access is
   begin
      return O.Item'Access;
   end;

   procedure Process (Item : access T_List_Item) is
   begin
      Put_Line ("processing T list item");
   end;
end P;
with Lists;  use Lists;

package P is
   type T is limited private;
   function List_Item (O : access T) return List_Item_Class_Access;
private
   type T_List_Item (O : access T) is new List_Item_Type with null record;
   procedure Process (Item : access T_List_Item);
   type T is limited record
      Item : aliased T_List_Item (T'Access);
   end record;
end P;
with Lists; use Lists;
with P;  use P;

procedure Test_Lists is

   O1 : aliased T;
   O2 : aliased T;

   L : List_Type;

begin

   Push (L, List_Item (O2'Access));
   Push (L, List_Item (O1'Access));

   Iterate (L);

end;