1-- { dg-do run } 2 3procedure BIP_Aggregate_Bug is 4 5 package Limited_Types is 6 7 type Lim_Tagged is tagged limited record 8 Root_Comp : Integer; 9 end record; 10 11 type Lim_Ext is new Lim_Tagged with record 12 Ext_Comp : Integer; 13 end record; 14 15 function Func_Lim_Tagged (Choice : Integer) return Lim_Tagged'Class; 16 17 end Limited_Types; 18 19 package body Limited_Types is 20 21 function Func_Lim_Tagged (Choice : Integer) return Lim_Tagged'Class is 22 begin 23 case Choice is 24 when 111 => 25 return Lim_Ext'(Root_Comp => Choice, Ext_Comp => Choice); 26 when 222 => 27 return Result : Lim_Tagged'Class 28 := Lim_Ext'(Root_Comp => Choice, Ext_Comp => Choice); 29 when others => 30 return Lim_Tagged'(Root_Comp => Choice); 31 end case; 32 end Func_Lim_Tagged; 33 34 end Limited_Types; 35 36 use Limited_Types; 37 38 LT_Root : Lim_Tagged'Class := Func_Lim_Tagged (Choice => 999); 39 LT_Ext1 : Lim_Tagged'Class := Func_Lim_Tagged (Choice => 111); 40 LT_Ext2 : Lim_Tagged'Class := Func_Lim_Tagged (Choice => 222); 41 42begin 43 if LT_Root.Root_Comp /= 999 44 or else Lim_Ext (LT_Ext1).Ext_Comp /= 111 45 or else Lim_Ext (LT_Ext2).Ext_Comp /= 222 46 then 47 raise Program_Error; 48 end if; 49end BIP_Aggregate_Bug; 50