[multiple changes]

2017-01-23  Ed Schonberg  <schonberg@adacore.com>

	* par-ch4.adb (P_Aggregate_Or_Parent_Expr): Recognize delta
	aggregate construct.
	(P_Record_Or_Array_Component_Association): An array aggregate
	can start with an Iterated_Component_Association.
	* scng.adb: Modify error message on improper use of @ in earlier
	versions of the language.
	* sinfo.ads: New node kind N_Delta_Aggregate.
	* sinfo.adb: An N_Delta_Aggregate has component associations and
	an expression.
	* sem_res.adb (Resolve): Call Resolve_Delta_Aggregate.
	* sem_aggr.ads, sem_aggr.adb (Resolve_Iterated_Component_Association):
	Create a new index for each one of the choices in the association,
	to prevent spurious homonyms in the scope.
	(Resolve_Delta_Aggregate): New.
	* sem.adb: An N_Delta_Aggregate is analyzed like an aggregate.
	* exp_util.adb (Insert_Actions): Take into account
	N_Delta_Aggregate.
	* exp_aggr.ads: New procedure Expand_N_Delta_Aggregate.
	* exp_aggr.adb: New procedure Expand_N_Delta_Aggregate,
	and local procedures Expand_Delta_Array_Aggregate and
	expand_Delta_Record_Aggregate.
	* sprint.adb: Handle N_Delta_Aggregate.

2017-01-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch11.adb (Expand_N_Exception_Declaration): Generate an
	empty name when the exception declaration is subject to pragma
	Discard_Names.
	(Null_String): New routine.

2017-01-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* par-ch9.adb (P_Protected_Definition): Parse
	any optional and potentially illegal pragmas which appear in
	a protected operation declaration list.
	(P_Task_Items): Parse
	any optional and potentially illegal pragmas which appear in a
	task item list.

From-SVN: r244794

1 files changed, 148 insertions, 0 deletions

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 9da35dd..a41bfa0 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -84,6 +84,9 @@ package body Exp_Aggr is
    --  expression with actions, which becomes the Initialization_Statements for
    --  Obj.
 
+   procedure Expand_Delta_Array_Aggregate  (N : Node_Id; Deltas : List_Id);
+   procedure Expand_Delta_Record_Aggregate (N : Node_Id; Deltas : List_Id);
+
    function Has_Default_Init_Comps (N : Node_Id) return Boolean;
    --  N is an aggregate (record or array). Checks the presence of default
    --  initialization (<>) in any component (Ada 2005: AI-287).
@@ -6436,6 +6439,151 @@ package body Exp_Aggr is
          return;
    end Expand_N_Aggregate;
 
+   ------------------------------
+   -- Expand_N_Delta_Aggregate --
+   ------------------------------
+
+   procedure Expand_N_Delta_Aggregate (N : Node_Id) is
+      Loc :  constant Source_Ptr := Sloc (N);
+      Temp : constant Entity_Id := Make_Temporary (Loc, 'T');
+      Typ  : constant Entity_Id := Etype (N);
+      Decl : Node_Id;
+
+   begin
+      Decl := Make_Object_Declaration (Loc,
+         Defining_Identifier => Temp,
+         Object_Definition => New_Occurrence_Of (Typ, Loc),
+         Expression => New_Copy_Tree (Expression (N)));
+
+      if Is_Array_Type (Etype (N)) then
+         Expand_Delta_Array_Aggregate (N, New_List (Decl));
+      else
+         Expand_Delta_Record_Aggregate (N, New_List (Decl));
+      end if;
+   end Expand_N_Delta_Aggregate;
+
+   ----------------------------------
+   -- Expand_Delta_Array_Aggregate --
+   ----------------------------------
+
+   procedure Expand_Delta_Array_Aggregate (N : Node_Id; Deltas : List_Id) is
+      Loc    : constant Source_Ptr := Sloc (N);
+      Temp   : constant Entity_Id  := Defining_Identifier (First (Deltas));
+      Assoc  : Node_Id;
+      Choice : Node_Id;
+      function Generate_Loop (C : Node_Id) return Node_Id;
+      --  Generate a loop containing individual component assignments for
+      --  choices that are ranges, subtype indications, subtype names, and
+      --  iterated component associations.
+
+      function Generate_Loop (C : Node_Id) return Node_Id is
+         Sl : constant Source_Ptr := Sloc (C);
+         Ix : Entity_Id;
+
+      begin
+         if Nkind (Parent (C)) = N_Iterated_Component_Association then
+            Ix :=
+              Make_Defining_Identifier (Loc,
+                Chars => (Chars (Defining_Identifier (Parent (C)))));
+         else
+            Ix := Make_Temporary (Sl, 'I');
+         end if;
+
+         return
+           Make_Loop_Statement (Loc,
+              Iteration_Scheme => Make_Iteration_Scheme (Sl,
+                Loop_Parameter_Specification =>
+                Make_Loop_Parameter_Specification (Sl,
+                  Defining_Identifier => Ix,
+                  Discrete_Subtype_Definition => New_Copy_Tree (C))),
+              End_Label => Empty,
+              Statements =>
+                New_List (
+                  Make_Assignment_Statement (Sl,
+                    Name       => Make_Indexed_Component (Sl,
+                      Prefix      => New_Occurrence_Of (Temp, Sl),
+                      Expressions => New_List (New_Occurrence_Of (Ix, Sl))),
+                    Expression => New_Copy_Tree (Expression (Assoc)))));
+      end Generate_Loop;
+
+   begin
+      Assoc := First (Component_Associations (N));
+      while Present (Assoc) loop
+         Choice := First (Choice_List (Assoc));
+         if Nkind (Assoc) = N_Iterated_Component_Association then
+            while Present (Choice) loop
+               Append_To (Deltas, Generate_Loop (Choice));
+               Next (Choice);
+            end loop;
+
+         else
+            while Present (Choice) loop
+
+               --  Choice can be given by a range, a subtype indication, a
+               --  subtype name, a scalar value, or an entity.
+
+               if Nkind (Choice) = N_Range
+                 or else (Is_Entity_Name (Choice)
+                   and then Is_Type (Entity (Choice)))
+               then
+                  Append_To (Deltas, Generate_Loop (Choice));
+
+               elsif Nkind (Choice) = N_Subtype_Indication then
+                  Append_To (Deltas,
+                    Generate_Loop (Range_Expression (Constraint (Choice))));
+
+               else
+                  Append_To (Deltas,
+                     Make_Assignment_Statement (Sloc (Choice),
+                       Name => Make_Indexed_Component (Sloc (Choice),
+                         Prefix => New_Occurrence_Of (Temp, Loc),
+                         Expressions => New_List (New_Copy_Tree (Choice))),
+                       Expression => New_Copy_Tree (Expression (Assoc))));
+               end if;
+
+               Next (Choice);
+            end loop;
+         end if;
+
+         Next (Assoc);
+      end loop;
+
+      Insert_Actions (N, Deltas);
+      Rewrite (N, New_Occurrence_Of (Temp, Loc));
+   end Expand_Delta_Array_Aggregate;
+
+   -----------------------------------
+   -- Expand_Delta_Record_Aggregate --
+   -----------------------------------
+
+   procedure Expand_Delta_Record_Aggregate (N : Node_Id; Deltas : List_Id) is
+      Loc    : constant Source_Ptr := Sloc (N);
+      Temp   : constant Entity_Id  := Defining_Identifier (First (Deltas));
+      Assoc  : Node_Id;
+      Choice : Node_Id;
+
+   begin
+      Assoc := First (Component_Associations (N));
+
+      while Present (Assoc) loop
+         Choice := First (Choice_List (Assoc));
+         while Present (Choice) loop
+            Append_To (Deltas,
+               Make_Assignment_Statement (Sloc (Choice),
+                 Name => Make_Selected_Component (Sloc (Choice),
+                   Prefix => New_Occurrence_Of (Temp, Loc),
+                   Selector_Name => Make_Identifier (Loc, Chars (Choice))),
+                 Expression => New_Copy_Tree (Expression (Assoc))));
+            Next (Choice);
+         end loop;
+
+         Next (Assoc);
+      end loop;
+
+      Insert_Actions (N, Deltas);
+      Rewrite (N, New_Occurrence_Of (Temp, Loc));
+   end Expand_Delta_Record_Aggregate;
+
    ----------------------------------
    -- Expand_N_Extension_Aggregate --
    ----------------------------------