gcc/testsuite/gnat.dg/abstract1.adb

   1 --  { dg-do compile }
   2 --  { dg-options "-gnatws" }
   3
   4 with Ada.Tags.Generic_Dispatching_Constructor;  use Ada.Tags;
   5 package body abstract1 is
   6
   7    function New_T (Stream : not null access Root_Stream_Type'Class)
   8       return T'Class is
   9       function Construct is
  10          new Generic_Dispatching_Constructor (T, Root_Stream_Type'Class, Input);
  11       E : constant String := String'Input (Stream);
  12       I : constant Tag := Internal_Tag (E);
  13
  14    begin
  15       return Construct (I, Stream);
  16    end New_T;
  17
  18    function Input (Stream : not null access Root_Stream_Type'Class)
  19      return IT is
  20    begin
  21       return O : IT do
  22         Integer'Read (Stream, O.I);
  23       end return;
  24    end Input;
  25
  26    function Input (Stream : not null access Root_Stream_Type'Class)
  27       return FT is
  28    begin
  29       return O : FT do
  30         Float'Read (Stream, O.F);
  31       end return;
  32    end Input;
  33 end abstract1;