From: Georg Bauhaus <sb463ba@l1-hrz.uni-duisburg.de>
Subject: Re: Question about OO programming in Ada
Date: Wed, 26 Nov 2003 15:10:54 +0000 (UTC)
Date: 2003-11-26T15:10:54+00:00 [thread overview]
Message-ID: <bq2fpu$pfj$1@a1-hrz.uni-duisburg.de> (raw)
In-Reply-To: bq0qfs$3ja$1@online.de
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;
next prev parent reply other threads:[~2003-11-26 15:10 UTC|newest]
Thread overview: 109+ messages / expand[flat|nested] mbox.gz Atom feed top
2003-11-25 19:04 Question about OO programming in Ada Ekkehard Morgenstern
2003-11-25 20:17 ` Randy Brukardt
2003-11-26 0:34 ` Ekkehard Morgenstern
2003-11-26 6:17 ` Vinzent 'Gadget' Hoefler
2003-11-26 9:29 ` Dmitry A. Kazakov
2003-11-26 15:54 ` Stephen Leake
2003-11-26 20:07 ` Randy Brukardt
2003-11-26 21:36 ` Stephen Leake
2003-11-26 8:56 ` Peter Hermann
2003-11-25 20:55 ` Martin Krischik
2003-11-26 0:22 ` Ekkehard Morgenstern
2003-11-26 1:00 ` Jeffrey Carter
2003-11-26 16:36 ` Martin Krischik
2003-11-26 18:09 ` Robert I. Eachus
2003-11-27 13:45 ` Jean-Pierre Rosen
2003-11-25 21:48 ` Stephen Leake
2003-11-26 0:01 ` Ekkehard Morgenstern
2003-11-26 1:16 ` Jeffrey Carter
2003-11-26 15:10 ` Georg Bauhaus [this message]
2003-11-26 15:48 ` Stephen Leake
2003-11-26 16:24 ` Hyman Rosen
2003-11-26 17:58 ` Robert I. Eachus
2003-11-27 2:10 ` Ekkehard Morgenstern
2003-11-27 10:15 ` Ludovic Brenta
2003-11-27 18:35 ` Jeffrey Carter
2003-11-28 4:35 ` Hyman Rosen
2003-11-28 7:28 ` Vinzent 'Gadget' Hoefler
2003-11-28 8:46 ` Dale Stanbrough
2003-11-28 10:16 ` Vinzent 'Gadget' Hoefler
2003-12-01 15:57 ` Martin Krischik
2003-12-01 16:47 ` Hyman Rosen
2003-12-03 18:35 ` Martin Krischik
2003-12-01 21:13 ` Jeffrey Carter
2003-12-02 8:47 ` Dmitry A. Kazakov
2003-12-03 9:29 ` Pascal Obry
2003-12-03 11:26 ` Dmitry A. Kazakov
2003-12-03 12:49 ` Ludovic Brenta
2003-12-03 13:41 ` Dmitry A. Kazakov
2003-12-03 14:11 ` Ludovic Brenta
2003-12-03 14:45 ` Dmitry A. Kazakov
2003-12-03 15:44 ` Hyman Rosen
2003-12-03 16:11 ` Dmitry A. Kazakov
2003-12-03 18:20 ` David C. Hoos
[not found] ` <28eb01c3b9ca$25b18870$b101a8c0@sy.com>
2003-12-03 18:35 ` Hyman Rosen
2003-12-03 20:05 ` Randy Brukardt
2003-12-03 20:57 ` Hyman Rosen
2003-12-03 21:16 ` Hyman Rosen
2003-12-03 22:04 ` Pascal Obry
2003-12-03 22:34 ` Hyman Rosen
2003-12-04 1:23 ` Robert I. Eachus
2003-12-04 7:15 ` Hyman Rosen
2003-12-04 17:43 ` Warren W. Gay VE3WWG
2003-12-04 8:55 ` Dmitry A. Kazakov
2003-12-04 19:13 ` Randy Brukardt
2003-12-04 19:29 ` Hyman Rosen
2003-12-04 21:32 ` Robert I. Eachus
2003-12-05 8:43 ` Dmitry A. Kazakov
2003-11-27 22:12 ` Robert I. Eachus
2003-11-28 6:37 ` Simon Wright
2003-11-30 2:51 ` Robert I. Eachus
2003-12-06 7:48 ` Chad Bremmon
2003-12-06 13:33 ` Jeff C,
2003-12-06 22:44 ` Hyman Rosen
2003-12-07 3:02 ` Chad Bremmon
2003-12-07 7:53 ` Hyman Rosen
2003-12-07 15:34 ` James Rogers
2003-12-07 18:30 ` Martin Krischik
2003-12-07 20:25 ` James Rogers
2003-12-08 3:36 ` Hyman Rosen
2003-12-08 4:42 ` Chad Bremmon
2003-12-08 8:42 ` Hyman Rosen
2003-12-08 9:34 ` Dmitry A. Kazakov
2003-12-08 13:25 ` Hyman Rosen
2003-12-08 15:05 ` Dmitry A. Kazakov
2003-12-09 4:38 ` Hyman Rosen
2003-12-09 8:19 ` Dmitry A. Kazakov
2003-12-09 13:29 ` Hyman Rosen
2003-12-09 14:36 ` Dmitry A. Kazakov
2003-12-09 15:05 ` Hyman Rosen
2003-12-09 15:59 ` Dmitry A. Kazakov
2003-12-09 16:41 ` Hyman Rosen
2003-12-10 11:32 ` Dmitry A. Kazakov
2003-12-10 15:27 ` Hyman Rosen
2003-12-10 17:15 ` Dmitry A. Kazakov
2003-12-08 17:55 ` Chad Bremmon
2003-12-08 23:09 ` Hyman Rosen
2003-12-09 8:26 ` Dmitry A. Kazakov
2003-12-08 19:33 ` Martin Krischik
2003-12-09 4:41 ` Hyman Rosen
2003-12-08 17:27 ` Chad Bremmon
2003-12-08 18:44 ` Georg Bauhaus
2003-12-08 19:27 ` Martin Krischik
2003-12-08 19:36 ` Chad Bremmon
2003-12-09 4:43 ` Hyman Rosen
2003-12-08 23:23 ` Hyman Rosen
2003-12-08 19:25 ` Martin Krischik
2003-12-07 21:29 ` Peter C. Chapin
2003-12-08 3:44 ` Hyman Rosen
2003-12-08 3:46 ` Hyman Rosen
2003-12-08 5:54 ` James Rogers
2003-12-08 8:45 ` Hyman Rosen
2003-12-07 17:39 ` Chad Bremmon
2003-12-08 23:39 ` Hyman Rosen
2003-12-09 2:36 ` Chad Bremmon
2003-12-09 4:52 ` Hyman Rosen
2003-12-09 11:24 ` Georg Bauhaus
2003-12-09 18:42 ` Chad Bremmon
2003-12-09 20:11 ` Hyman Rosen
2003-12-08 23:40 ` Hyman Rosen
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox