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;
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) :=