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: "Matthew Heaney" <matthew_heaney@acm.org>
Subject: Re: How to?: Re-dispatching within an inherited method
Date: 1999/08/17
Message-ID: <37b9a823@news1.us.ibm.net>#1/1
X-Deja-AN: 513886266
Content-transfer-encoding: 7bit
References: <37AF0ADE.3D80FEB3@hiwaay.net> <7onk8f$2qg@hobbes.crc.com>
X-Trace: 17 Aug 1999 18:21:23 GMT, 32.101.8.24
Organization: Global Network Services - Remote Access Mail & News Services
X-Notice: should be reported to postmaster@ibm.net
Content-Type: text/plain; charset="US-ASCII"
Mime-version: 1.0
Newsgroups: comp.lang.ada
X-Complaints-To: postmaster@ibm.net
Date: 1999-08-17T00:00:00+00:00
List-Id: <comp.lang.ada>

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;


>    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"