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.3 required=5.0 tests=BAYES_00,INVALID_MSGID
	autolearn=no autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,a370fcbf5c4dae94
X-Google-Attributes: gid103376,public
From: "David C. Hoos, Sr." <david.c.hoos.sr@ada95.com>
Subject: Re: How to?: Re-dispatching within an inherited method
Date: 1999/08/17
Message-ID: <7pcar9$aeg@hobbes.crc.com>#1/1
X-Deja-AN: 513906737
References: <37AF0ADE.3D80FEB3@hiwaay.net> <7onk8f$2qg@hobbes.crc.com>
 <37b9a823@news1.us.ibm.net>
X-Priority: 3
X-MimeOLE: Produced By Microsoft MimeOLE V5.00.2314.1300
Organization: Coleman Research Corporation
X-MSMail-Priority: Normal
Newsgroups: comp.lang.ada
Date: 1999-08-17T00:00:00+00:00
List-Id: <comp.lang.ada>


Matthew Heaney <matthew_heaney@acm.org> wrote in message
news:37b9a823@news1.us.ibm.net...
> In article <7onk8f$2qg@hobbes.crc.com> , "David C. Hoos, Sr."
> <david.c.hoos.sr@ada95.com> wrote:
>
> > Yes.  You need to type convert the actual parameter in the call to
> > Widget'Class to make the call a dispatching call.  See RM 95 3.9.2 (1,
5).
> >
> > As in the example:
> >
> > with Ada.Text_IO;
> > package body A is
> >
> >    procedure Run_Widget (The_Widget : Widget'Class) is
> >    begin
> >       Ada.Text_IO.Put_Line
> >         ("in Run_Widget (The_Widget : Widget): Size =" &
> >          Positive'Image (Widget_Size (Widget'Class (The_Widget))));
>
> Did you really mean to declare the formal parameter The_Widget in
operation
> Run_Widget as having type Widget'Class?  If so, then there's no need for
> your explicit conversion of The_Widget to type Widget'Class, because
that's
> already its type.
>
> The other problem with this solution is that Run_Widget is no longer
> primitive, because it takes a class-wide parameter.  The operation is NOT
> inherited during derivation.
>
> I suspect that what you really meant was
>
>   procedure Run_Widget (The_Widget : Widget) is
>   begin
>     ... Widget_Size (Widget'Class (The_Widget)) ...
>   end;
>
>
Well... I really did mean to make Run_Widget class-wide.  This
may not have beeen consistent with the posting's subject line,
however.

Without completely redesigning the type hierarchy (I would
probably have made Widget abstract, and gone from there),
I was trying to get at the dispatching issue.

And... yes, having made Run_Widget class-wide, the type
conversion is unneccessary.

Without a class-wide Run_Widget, however, the call to
Run_Widget with an actual parameter of type BigWidget is
illegal -- a type conversion is required there.

> >    end Run_Widget;
> >
> >    function Widget_Size (The_Widget : Widget) return Positive is
> >    begin
> >       return 1;
> >    end Widget_Size;
> >
> > end A;
> >
> >
> > package A is
> >    type Widget is tagged null record;
> >    procedure Run_Widget (The_Widget : Widget'Class);
>
> I think you want this:
>
>   procedure Run_Widget (The_Widget : Widget);
>
>
> >    function Widget_Size (The_Widget : Widget) return Positive;
> > end A;
> >
> > package body B is
> >    function Widget_Size (The_Widget : BigWidget) return Positive is
> >    begin
> >       return 10;
> >    end Widget_Size;
> > end B;
> >
> > with A;
> > package B is
> >    type BigWidget is new A.Widget with null record;
> >    function Widget_Size (The_Widget : BigWidget) return Positive;
> > end B;
> >
> > with A;
> > with B;
> > procedure Glover is
> >
> >    The_Widget : A.Widget;
> >    The_BigWidget : B.BigWidget;
> >
> > begin
> >
> >    A.Run_Widget (The_Widget);
> >    A.Run_Widget (The_BigWidget);
>
> With the change, you can say:
>
>   B.Run_Widget (The_BigWidget);
>
> and all is well.
>
> > end Glover;
>
> --
> Matt
>
> It is impossible to feel great confidence in a negative theory which has
> always rested its main support on the weak points of its opponent.
>
> Joseph Needham, "A Mechanistic Criticism of Vitalism"