typesada

What causes the syntax error in an Ada extension aggregate for a limited type? Commented out sectin gets the syntax error


The following code uses two different ways to create a record and initialize a value of that type. It's in package p3. The version that is commented out gets a syntax error which I don't understand. Is there another construct that won't get the error? The commented version compiles and generates the expected result.

with Ada.Text_IO; use Ada.Text_IO;

procedure Example is

   package p1 is
      type base_type is tagged limited private;

      function image (
        base : in base_type
      ) return string;

      private

      type base_type is tagged limited record
        f1 : integer := 99;
      end record;

   end p1;

   package p2 is

      type child_type (
        cs : natural) is new p1.base_type with private;

      c : constant child_type;

      function create_child (
         cs : natural;
         f2 : boolean
      ) return child_type;

      overriding
      function image (
        child : in child_type
      ) return string;

      private
      type child_type (
         cs : natural) is new p1.base_type with record
         f2 : boolean;
      end record;

      c : constant child_type := (
         p1.base_type with
         cs => 3,
         f2 => false);

   end p2;

   package p3 is

      type grandchild_type (
         cs : natural) is tagged limited record
         parent : p2.child_type (cs);
         f3 : character;
      end record;

      procedure print (
        gc : in grandchild_type);

      -- type uncle_type (
      --   cs : natural) is new p2.child_type (cs) with record
      --   f3 : character;
      -- end record;
      --
      -- overriding
      -- function create_child (
      --   cs : natural;
      --   f2 : boolean
      -- ) return uncle_type;
      --
      -- procedure print (
      --   gc : in uncle_type);

   end p3;

   package body p1 is

      function image (
      base : in base_type
      ) return string is

      begin
      return "f1" & base.f1'img;
      end image;
   end p1;

   package body p2 is

   function create_child (
      cs : natural;
      f2 : boolean
   ) return child_type is

   begin
   return (p1.base_type with
      cs => cs,
      f2 => f2);
   end create_child;

   overriding
   function image (
     child : in child_type
   ) return string is

   begin
      return "base " & p1.base_type (child).image &
      " cs" & child.cs'img &
      " f2 " & child.f2'img;
   end image;

   end p2;

   child : constant p2.child_type := p2.create_child (2, true);

   package body p3 is

   procedure print (
     gc : in grandchild_type) is

   begin
      put_line ("parent: " & gc.parent.image &
      " cs: " & gc.cs'img &
      " f3: " & gc.f3'img);
   end print;

   -- overriding
   -- function create_child (
   --   cs : natural;
   --   f2 : boolean
   -- ) return uncle_type is
   --
   -- begin
   --   return (
   --   p2.create_child (
   --   cs => 4,
   --   f2 => true) with
   --   cs => 2,
   --   f3 => 'x');
   -- end create_child;
   --
   -- procedure print (
   --   gc : in uncle_type) is
   --
   -- begin
   --   put_line ("parent: " & p2.child_type (gc).image &
   --     " cs: " & gc.cs'img &
   --     " f3: " & gc.f3'img);
   -- end print;

   end p3;

   g : constant p3.grandchild_type (cs => 3) := (
     cs => 3,
     parent => p2.create_child (3, false),
     f3 => 'a');

begin
   put_line ("child " & child.image);
   put_line ("p2.c " & p2.c.image);
   g.print;
end Example;

Solution

  • I’ve found a solution to the compilation issue (the compiler said error: type of limited ancestor part must be constrained) by this change:

          overriding function Create_Child
            (Cs : Natural; F2 : Boolean) return Uncle_Type
          is
             subtype Ancestor is P2.Child_Type (Cs => 4);
          begin
             return
               (Ancestor'(P2.Create_Child (Cs => 4, F2 => True))
                with Cs => 2, F3 => 'x');
          end Create_Child;
    

    (please forgive the reformatting & re-casing).

    It does seem strange that this should be needed, particularly since the return from P2.Create_Child must be constrained.

    I think there’ll be more, similar issues when you try to declare

       U : constant P3.Uncle_Type (Cs => 4) :=