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,56131a5c3acc678e
X-Google-Attributes: gid103376,public
X-Google-ArrivalTime: 2003-11-26 07:10:55 PST
Path: 
 archiver1.google.com!news2.google.com!fu-berlin.de!cs.tu-berlin.de!uni-duisburg.de!not-for-mail
From: Georg Bauhaus <sb463ba@l1-hrz.uni-duisburg.de>
Newsgroups: comp.lang.ada
Subject: Re: Question about OO programming in Ada
Date: Wed, 26 Nov 2003 15:10:54 +0000 (UTC)
Organization: GMUGHDU
Message-ID: <bq2fpu$pfj$1@a1-hrz.uni-duisburg.de>
References: <bq092s$9ph$1@online.de> <uhe0sqfud.fsf@nasa.gov>
 <bq0qfs$3ja$1@online.de>
NNTP-Posting-Host: l1-hrz.uni-duisburg.de
X-Trace: a1-hrz.uni-duisburg.de 1069859454 26099 134.91.1.34 (26 Nov 2003
 15:10:54 GMT)
X-Complaints-To: usenet@news.uni-duisburg.de
NNTP-Posting-Date: Wed, 26 Nov 2003 15:10:54 +0000 (UTC)
User-Agent: tin/1.5.8-20010221 ("Blue Water") (UNIX) (HP-UX/B.11.00
 (9000/800))
Xref: archiver1.google.com comp.lang.ada:2959
Date: 2003-11-26T15:10:54+00:00
List-Id: <comp.lang.ada>

Ekkehard Morgenstern <ekkehard.morgenstern@onlinehome.de> wrote:
: 
: I gathered from what I read that I need to declare My_Type1 as a tagged
: type.

Yes.
 
: Now, I read that method dispatching (with static dispatching corresponding
: to method overloading in C++, and runtime dispatching corresponding to
: virtual methods in C++), would be possible only by using a class-wide type,
: such as My_Type1'Class in the first parameter of a procedure or in the
: return value of a function.

Uhm, if you really have a need for runtime dispatching, not just
"virtual objects", that is. For example, if one Node needs to be
hooked onto another, where the other node is a Very_Specialised_Node
remotely derived from Node, they still both have the "hooking" operations
of Node. If they have the names a and vsa, respectively, then a call on
the hooking procedure declared as hook(n1, n2: in out Node) might look
like

   hook(a, Node(vsa));

vsa is then seen as a Node. (Not casted, just a view conversion)


Here is an example that demonstrates a few things, whether it is
well done or not I can't say.
It isn't complete but I'm sure you can add some functionality.


package Disp is

   type My_Type1 is
     tagged record
        Field1 : Integer := 100;
        Field2:  Integer := 42;
     end record;


   procedure op (item: in out My_Type1);
   function f1 (item: My_Type1) return Integer;

   type My_Type2 is new My_Type1 with
     record
        Field3 : Integer := -100;
        Field4:  Integer := 5_000_000;
     end record;

   procedure op (item: in out My_Type2);
   --  inherit f1

end Disp;


with Ada.Text_IO;   use Ada;

package body Disp is

   procedure op (item: in out My_Type1) is
   begin
      Text_IO.put_line("op enter for My_Type1");
      item := (Field1 => item.Field1 + 1,
               Field2 => item.Field2 - 42);

      Text_IO.put_line("op leave for My_Type1");
   end op;

   function f1 (item: My_Type1) return Integer is
   begin
      return item.Field1;
   end f1;



   procedure op (item: in out My_Type2) is
   begin
      Text_IO.put_line("op enter for My_Type2");

      --  view item as a My_Type1 object (conversion)
      --  and call the corresponding op:

      op(My_Type1(item));

      item.Field4 := 0;

      Text_IO.put_line("op leave for My_Type2");
   end op;

   --  inherit f1

end Disp;


with disp; use disp;

with Ada.Text_IO;  use Ada;

procedure disp_test is

   x1: aliased My_Type1;    -- aliased is here because of the pointers
   x2: aliased My_Type2;    -- I rarely need them

   type Any_Of_My_Type is access all My_Type1'Class;

   xc: Any_Of_My_Type;

   procedure choose(x: in out My_Type1'Class);
   --  calls an op depending on x's type

   procedure as_well(x: access My_Type1'Class);
   --  calls an op depending on x's designated type

   procedure choose(x: in out My_Type1'Class) is
   begin
      op(x);
   end choose;


   procedure as_well(x: access My_Type1'Class) is
   begin
      op(x.all);
   end as_well;

begin

   --  calls on operations of x1's and x2's types, resp

   Text_IO.put_line("x1's Field1: " & Integer'image(f1(x1)));
   Text_IO.put_line("x2's Field1: " & Integer'image(f1(x2)));

   op(x1);

   Text_IO.put_line("x1's Field1: " & Integer'image(f1(x1)));
   Text_IO.put_line("x2's Field1: " & Integer'image(f1(x2)));

   op(x2);

   Text_IO.put_line("x1's Field1: " & Integer'image(f1(x1)));
   Text_IO.put_line("x2's Field1: " & Integer'image(f1(x2)));


   --  xc will point to objects of type My_Type1 or My_Type2

   Text_IO.put_line("moving pointers");

   xc := x1'access;
   op(xc.all);

   Text_IO.put_line("x1's Field1: " & Integer'image(f1(x1)));
   Text_IO.put_line("x2's Field1: " & Integer'image(f1(x2)));

   xc := x2'access;
   op(xc.all);

   Text_IO.put_line("x1's Field1: " & Integer'image(f1(x1)));
   Text_IO.put_line("x2's Field1: " & Integer'image(f1(x2)));


   Text_IO.put_line("have the tag decide");

   choose(x1);
   choose(x2);
   choose(xc.all);

   Text_IO.put_line("have the tag decide, too");

   as_well(x1'access);
   as_well(x2'access);
   as_well(xc);

end disp_test;