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=-0.3 required=5.0 tests=BAYES_00,
	REPLYTO_WITHOUT_TO_CC autolearn=no autolearn_force=no version=3.4.4
X-Google-Thread: 103376,8385fc6e4bf20336
X-Google-Attributes: gid103376,domainid0,public,usenet
X-Google-Language: ENGLISH,ASCII-7-bit
Path: 
 g2news1.google.com!news4.google.com!news.germany.com!news.belwue.de!newsfeed.arcor.de!newsspool3.arcor-online.net!news.arcor.de.POSTED!not-for-mail
Date: Tue, 01 Apr 2008 09:22:56 +0200
From: Georg Bauhaus <rm.tsoh.plus-bug.bauhaus@maps.futureapps.de>
Reply-To: rm.tsoh+bauhaus@maps.futureapps.de
User-Agent: Thunderbird 2.0.0.12 (Windows/20080213)
MIME-Version: 1.0
Newsgroups: comp.lang.ada
Subject: Re: Generics with concrete and class-wide types
References: <279b6f4f-36cf-446f-8b54-fd72b957b22f@i7g2000prf.googlegroups.com>
In-Reply-To: 
 <279b6f4f-36cf-446f-8b54-fd72b957b22f@i7g2000prf.googlegroups.com>
Content-Type: text/plain; charset=ISO-8859-1
Content-Transfer-Encoding: 7bit
Message-ID: <47f1e2d0$0$4748$9b4e6d93@newsspool3.arcor-online.net>
Organization: Arcor
NNTP-Posting-Date: 01 Apr 2008 09:22:56 CEST
NNTP-Posting-Host: f5dfb4a6.newsspool3.arcor-online.net
X-Trace: 
 DXC=U`_>3:TEe;1n`gW2MTm]<3McF=Q^Z^V384Fo<]lROoR1^;5]aA^R6>24m1m]eaDAc8PCY\c7>ejV8hKZ^NYKM3T7hd`^kRAMHS>
X-Complaints-To: usenet-abuse@arcor.de
Xref: g2news1.google.com comp.lang.ada:20702
Date: 2008-04-01T09:22:56+02:00
List-Id: <comp.lang.ada>

Maciej Sobczak wrote:
> Consider a generic subprogram that makes sense for arguments of both
> class-wide type and a concrete type.

> -- does not compile:
> procedure SP is new Some_Procedure
>   (T => Integer, Iterator_Type => Iterator_Integer'Class); -- Bang!

FWIW, the following triggers everything from a running
program to an Ada 95 compiler internal assertion failure
(in case the iterator object is initialized in the main
procedure).


with Iterators, Some_Procedure;
procedure Test_Iterators is

   package II is new Iterators(Integer);

   procedure Context_Conc(it: II.Conc_Iter) is
      procedure SP is new Some_Procedure
        (Integer, II, Iterator_Type => II.Conc_Iter);
   begin
      SP(it);
   end Context_Conc;

   procedure Context_Disp(it: II.Iterator'Class) is
      procedure SP is new Some_Procedure
        (Integer, II, Iterator_Type => II.Iterator'Class);
   begin
      SP(it);
   end Context_Disp;

   c: II.Conc_Iter := II.Conc_Iter'(El => new Integer'(42));
begin
   Context_Conc(c);
   Context_Disp(c);
end Test_Iterators;

with Iterators;
generic
   type T is private;
   with package Integer_Iterators is new Iterators(T);
   type Iterator_Type(<>) is new Integer_Iterators.Iterator with private;
procedure Some_Procedure (it: Iterator_Type);


generic
   type T is private;
package Iterators is

   type Iterator is abstract tagged null record;
   function Get(It: Iterator) return T is abstract;

   type T_Ptr is access constant T;
   type Conc_Iter is new Iterator with
      record
         El: T_Ptr;
      end record;

   function Get(It: Conc_Iter) return T;

end Iterators;


procedure Some_Procedure (It: Iterator_Type) is
   use type Integer_Iterators.Iterator;
   Tmp: T;
begin
   Tmp := Get(It);
end Some_Procedure;


package body Iterators is

   function Get (It: Conc_Iter) return T is
   begin
      return It.El.all;
   end Get;

end Iterators;