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,72113392dc4997bd
X-Google-Attributes: gid103376,public
X-Google-ArrivalTime: 2003-04-16 22:27:38 PST
Path: 
 archiver1.google.com!news1.google.com!newsfeed.stanford.edu!logbridge.uoregon.edu!arclight.uoregon.edu!wn13feed!worldnet.att.net!204.127.198.203!attbi_feed3!attbi.com!rwcrnsc53.POSTED!not-for-mail
From: tmoran@acm.org
Newsgroups: comp.lang.ada
Subject: Re: Subprogram Pointer in a Generic
References: <slrnb9s72m.hvi.sam@willow.dyn.rfc1149.net>
X-Newsreader: Tom's custom newsreader
Message-ID: <eXqna.513677$S_4.562153@rwcrnsc53>
NNTP-Posting-Host: 12.234.13.56
X-Complaints-To: abuse@attbi.com
X-Trace: rwcrnsc53 1050557258 12.234.13.56 (Thu, 17 Apr 2003 05:27:38 GMT)
NNTP-Posting-Date: Thu, 17 Apr 2003 05:27:38 GMT
Organization: AT&T Broadband
Date: Thu, 17 Apr 2003 05:27:38 GMT
Xref: archiver1.google.com comp.lang.ada:36228
Date: 2003-04-17T05:27:38+00:00
List-Id: <comp.lang.ada>

> It is the other way around: he wants to call the procedure taking
> the access-to-subprogram formal parameter *from* within the body of
> the generic package.

> (2) Is there a more robust way of working around it?
  You want to be able to save away a pointer to a procedure?  A tagged
type carries a vector of procedure pointers, so an "access T'class"
is effectively a simple pointer to a list of (one or more) pointers.
The following code registers two instantiations of a generic, one
with a "type T is Positive" and the other with "type T is Boolean".
It then calls the saved registerees, printing for T'image(T'first)
 1
FALSE

package Testr is
  type Registerable_Type is abstract tagged null record;
  procedure Proc(Dummy : Registerable_Type) is abstract;

  type Ptr_To_Registerable_Type is access all Registerable_Type'Class;
  procedure Register(Registeree : Ptr_To_Registerable_Type);

  procedure Call(Index : in Integer);
end Testr;

package body Testr is
  P : array (1 .. 3) of Ptr_To_Registerable_Type;
  N : Natural := 0;

  procedure Register(Registeree : Ptr_To_Registerable_Type) is
  begin
    N := N + 1;
    P(N) := Registeree;
  end Register;

  procedure Call(Index : in Integer) is
  begin
    Proc(P(Index).all);
  end Call;
end Testr;

with Testr;
generic
  type T is (<>);
package Testrg is
  procedure Register_It;
private
  type My_Registerable_Type is new Testr.Registerable_Type with null record;
  procedure Proc(Dummy : My_Registerable_Type);
end Testrg;

with Ada.Text_Io;
package body Testrg is
  Jump_Vector: aliased My_Registerable_Type;

  procedure Proc(Dummy : My_Registerable_Type) is
  begin
    Ada.Text_Io.Put_Line(T'Image(T'First));
  end Proc;

  procedure Register_It is
  begin
    Testr.Register(Jump_Vector'unchecked_access);
  end Register_It;
end Testrg;

with Testrg;
package Testr1 is
  package A is new Testrg(Positive);
  package B is new Testrg(Boolean);
end Testr1;

with Testr1, Testr;
with Ada.Text_Io;
procedure Testr2 is
begin
  Testr1.A.Register_It;
  Testr1.B.Register_It;
  Testr.Call(1);  -- first registeree was A, type T was Positive
  Testr.Call(2);  -- second registeree was B, type T was Boolean
end Testr2;