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