diff mbox

[Ada] Aggregate for records with components of an anonymous access type

Message ID 20101007130648.GA14808@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Oct. 7, 2010, 1:06 p.m. UTC 
In Ada2012, a choice list in an aggregate can include several components of
anonymous access types, as long as their designated subtypes match.
The following must compile quietly in Ada2012 mode:

procedure Record_Aggregate is
  type List_Element1 is record
     Data       : Integer;
     Prev, Next : access List_Element1;
  end record;

  type List_Element2;
  type List_Element2_Access is access all List_Element2;
  type List_Element2 is record
     Data       : Integer;
     Prev, Next : List_Element2_Access;
  end record;

  Obj1 : List_Element1;
  Obj2 : List_Element2;

begin
  Obj2 := (Data => -1, Prev | Next => null);

  Obj1 := (Data => -1, Prev | Next => null);
  Obj1 := (Data =>  3, Prev | Next => new List_Element1);
end;

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-10-07  Ed Schonberg  <schonberg@adacore.com>

	* sem_aggr.adb (Analyze_Record_Aggregate): In Ada2012, a choice list
	in a record aggregate can correspond to several components of
	anonymous access types, as long as the designated subtypes match.
diff mbox

Patch

Index: sem_aggr.adb
===================================================================
--- sem_aggr.adb	(revision 165080)
+++ sem_aggr.adb	(working copy)
@@ -3890,8 +3890,23 @@  package body Sem_Aggr is
                elsif No (Typech) then
                   Typech := Base_Type (Etype (Component));
 
+               --  AI05-0199: In Ada2012, several components of anonymous
+               --  access types can appear in a choice list, as long as the
+               --  designated types match.
+
                elsif Typech /= Base_Type (Etype (Component)) then
-                  if not Box_Present (Parent (Selectr)) then
+                  if Ada_Version >= Ada_12
+                    and then Ekind (Typech) = E_Anonymous_Access_Type
+                    and then
+                       Ekind (Etype (Component)) = E_Anonymous_Access_Type
+                    and then Base_Type (Designated_Type (Typech)) =
+                             Base_Type (Designated_Type (Etype (Component)))
+                    and then
+                      Subtypes_Statically_Match (Typech, (Etype (Component)))
+                  then
+                     null;
+
+                  elsif not Box_Present (Parent (Selectr)) then
                      Error_Msg_N
                        ("components in choice list must have same type",
                         Selectr);