gcc/testsuite/gnat.dg/derived_type3_pkg.adb

   1 with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
   2 with Ada.Text_IO; use Ada.Text_IO;
   3
   4 package body Derived_Type3_Pkg is
   5
   6    type Parent is tagged null record;
   7
   8    type Child is new Parent with
   9       record
  10          Image : Ada.Strings.Unbounded.Unbounded_String;
  11       end record;
  12
  13    function Set_Image return Child'class is
  14       Local_Data : Child;
  15    begin
  16       Local_Data.Image := To_Unbounded_String ("Hello");
  17       return Local_Data;
  18    end Set_Image;
  19
  20    procedure Proc1 is
  21       The_Data : Parent'class := Set_Image;
  22    begin
  23       Put_Line ("Child'Alignment =" & Child'Alignment'Img);
  24       Put_Line ("The_Data'Alignment =" & The_Data'Alignment'Img);
  25    end;
  26
  27    procedure Proc2 is
  28
  29       procedure Nested (X : Parent'Class) is
  30         The_Data : Parent'Class := X;
  31       begin
  32         Put_Line ("Child'Alignment =" & Child'Alignment'Img);
  33         Put_Line ("The_Data'Alignment =" & The_Data'Alignment'Img);
  34       end;
  35
  36       The_Data : Parent'Class := Set_Image;
  37
  38    begin
  39       Nested (The_Data);
  40    end;
  41
  42 end Derived_Type3_Pkg;