1-- { dg-do run } 2 3with Ada.Text_IO, Ada.Tags; 4procedure Test_Iface_Aggr is 5 package Pkg is 6 type Iface is interface; 7 function Constructor (S: Iface) return Iface'Class is abstract; 8 procedure Do_Test (It : Iface'class); 9 type Root is abstract tagged record 10 Comp_1 : Natural := 0; 11 end record; 12 type DT_1 is new Root and Iface with record 13 Comp_2, Comp_3 : Natural := 0; 14 end record; 15 function Constructor (S: DT_1) return Iface'Class; 16 type DT_2 is new DT_1 with null record; -- Test 17 function Constructor (S: DT_2) return Iface'Class; 18 end; 19 package body Pkg is 20 procedure Do_Test (It: in Iface'Class) is 21 Obj : Iface'Class := Constructor (It); 22 S : String := Ada.Tags.External_Tag (Obj'Tag); 23 begin 24 null; 25 end; 26 function Constructor (S: DT_1) return Iface'Class is 27 begin 28 return Iface'Class(DT_1'(others => <>)); 29 end; 30 function Constructor (S: DT_2) return Iface'Class is 31 Result : DT_2; 32 begin 33 return Iface'Class(DT_2'(others => <>)); -- Test 34 end; 35 end; 36 use Pkg; 37 Obj: DT_2; 38begin 39 Do_Test (Obj); 40end; 41