with System;
with System.Memory;
 
with Ada.Text_IO;
with Ada.Tags;
with Ada.Tags.Generic_Dispatching_Constructor;
 
procedure Test is
 
  type Point is tagged record
    X, Y : Natural;
  end record;
 
  procedure Put_Point (Item : in Point'class) is begin
    Ada.Text_IO.Put ("X: " & Item.X'image);
    Ada.Text_IO.Put ("Y: " & Item.Y'image);
  end;
 
  type Saturation is range 0 .. 255;
 
  type Pixel is new Point with record
    Red   : Saturation;
    Green : Saturation;
    Blue  : Saturation;
  end record;
 
  procedure Put_Pixel (Item : in Pixel) is begin
    Put_Point (Item);
    Ada.Text_IO.Put ("RGB: (" & Item.Red'Image & "," & Item.Green'Image & "," & Item.Blue'Image & ")");
  end;
 
  type Tile is new Point with record
    Elevation : Natural;
  end record;
 
  procedure Put_Tile (Item : in Tile) is begin
    Put_Point (Item);
    Ada.Text_IO.Put ("Elevation: " & Item.Elevation'Image);
  end;
 
  function Alloc (Size : not null access System.Memory.size_t) return Point'class is
    Instance_Address : System.Address := System.Memory.Alloc (Size.all);
    Instance : Point'class;
    for Instance'address use Instance_Address;
  begin
    return Instance;
  end;
 
  procedure Free (P : Point'class) is begin
    System.Memory.Free (P'address);
  end;
 
  function New_Point is new Ada.Tags.Generic_Dispatching_Constructor (T => Point, Parameters => System.Memory.size_t, Constructor => Alloc);
 
  Point_Size : aliased System.Memory.size_t := Point'Size;
  P1 : Point := New_Point (Point'Tag, Point_Size'access);
begin
  Put_Point (P1);
end;

d2l0aCBTeXN0ZW07CndpdGggU3lzdGVtLk1lbW9yeTsKCndpdGggQWRhLlRleHRfSU87CndpdGggQWRhLlRhZ3M7CndpdGggQWRhLlRhZ3MuR2VuZXJpY19EaXNwYXRjaGluZ19Db25zdHJ1Y3RvcjsKCnByb2NlZHVyZSBUZXN0IGlzCiAgCiAgdHlwZSBQb2ludCBpcyB0YWdnZWQgcmVjb3JkCiAgICBYLCBZIDogTmF0dXJhbDsKICBlbmQgcmVjb3JkOwogIAogIHByb2NlZHVyZSBQdXRfUG9pbnQgKEl0ZW0gOiBpbiBQb2ludCdjbGFzcykgaXMgYmVnaW4KICAgIEFkYS5UZXh0X0lPLlB1dCAoIlg6ICIgJiBJdGVtLlgnaW1hZ2UpOwogICAgQWRhLlRleHRfSU8uUHV0ICgiWTogIiAmIEl0ZW0uWSdpbWFnZSk7CiAgZW5kOwogICAKICB0eXBlIFNhdHVyYXRpb24gaXMgcmFuZ2UgMCAuLiAyNTU7CiAgIAogIHR5cGUgUGl4ZWwgaXMgbmV3IFBvaW50IHdpdGggcmVjb3JkCiAgICBSZWQgICA6IFNhdHVyYXRpb247CiAgICBHcmVlbiA6IFNhdHVyYXRpb247CiAgICBCbHVlICA6IFNhdHVyYXRpb247CiAgZW5kIHJlY29yZDsKICAKICBwcm9jZWR1cmUgUHV0X1BpeGVsIChJdGVtIDogaW4gUGl4ZWwpIGlzIGJlZ2luCiAgICBQdXRfUG9pbnQgKEl0ZW0pOwogICAgQWRhLlRleHRfSU8uUHV0ICgiUkdCOiAoIiAmIEl0ZW0uUmVkJ0ltYWdlICYgIiwiICYgSXRlbS5HcmVlbidJbWFnZSAmICIsIiAmIEl0ZW0uQmx1ZSdJbWFnZSAmICIpIik7CiAgZW5kOwogICAKICB0eXBlIFRpbGUgaXMgbmV3IFBvaW50IHdpdGggcmVjb3JkCiAgICBFbGV2YXRpb24gOiBOYXR1cmFsOwogIGVuZCByZWNvcmQ7CiAgCiAgcHJvY2VkdXJlIFB1dF9UaWxlIChJdGVtIDogaW4gVGlsZSkgaXMgYmVnaW4KICAgIFB1dF9Qb2ludCAoSXRlbSk7CiAgICBBZGEuVGV4dF9JTy5QdXQgKCJFbGV2YXRpb246ICIgJiBJdGVtLkVsZXZhdGlvbidJbWFnZSk7CiAgZW5kOwogIAogIGZ1bmN0aW9uIEFsbG9jIChTaXplIDogbm90IG51bGwgYWNjZXNzIFN5c3RlbS5NZW1vcnkuc2l6ZV90KSByZXR1cm4gUG9pbnQnY2xhc3MgaXMKICAgIEluc3RhbmNlX0FkZHJlc3MgOiBTeXN0ZW0uQWRkcmVzcyA6PSBTeXN0ZW0uTWVtb3J5LkFsbG9jIChTaXplLmFsbCk7CiAgICBJbnN0YW5jZSA6IFBvaW50J2NsYXNzOwogICAgZm9yIEluc3RhbmNlJ2FkZHJlc3MgdXNlIEluc3RhbmNlX0FkZHJlc3M7CiAgYmVnaW4KICAgIHJldHVybiBJbnN0YW5jZTsKICBlbmQ7CiAgCiAgcHJvY2VkdXJlIEZyZWUgKFAgOiBQb2ludCdjbGFzcykgaXMgYmVnaW4KICAgIFN5c3RlbS5NZW1vcnkuRnJlZSAoUCdhZGRyZXNzKTsKICBlbmQ7CiAgCiAgZnVuY3Rpb24gTmV3X1BvaW50IGlzIG5ldyBBZGEuVGFncy5HZW5lcmljX0Rpc3BhdGNoaW5nX0NvbnN0cnVjdG9yIChUID0+IFBvaW50LCBQYXJhbWV0ZXJzID0+IFN5c3RlbS5NZW1vcnkuc2l6ZV90LCBDb25zdHJ1Y3RvciA9PiBBbGxvYyk7CgogIFBvaW50X1NpemUgOiBhbGlhc2VkIFN5c3RlbS5NZW1vcnkuc2l6ZV90IDo9IFBvaW50J1NpemU7CiAgUDEgOiBQb2ludCA6PSBOZXdfUG9pbnQgKFBvaW50J1RhZywgUG9pbnRfU2l6ZSdhY2Nlc3MpOwpiZWdpbgogIFB1dF9Qb2ludCAoUDEpOwplbmQ7