[COMMITTED] ada: Missing error on positional container aggregates for types with Add_Named

[COMMITTED] ada: Missing error on positional container aggregates for types with Add_Named

[Marc Poulhiès]

From: Gary Dismukes <dismukes@adacore.com>

The compiler fails to reject a container aggregate written using positional
notation when the container type specifies an Add_Named operation in its
Aggregate aspect. Container aggregates for such types must be written using
named associations. The compiler ignores the positional associations and
produces an empty aggregate object. An error check is added to catch such
illegal container aggregates.

gcc/ada/

	* sem_aggr.adb (Resolve_Container_Aggregate): In the Add_Named
	case, issue an error if the container aggregate is written as a
	positional aggregate, since such an aggregate must have named
	associations.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_aggr.adb | 20 +++++++++++++++++---
 1 file changed, 17 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index bf249620d04..1027acf20b5 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -3436,11 +3436,25 @@ package body Sem_Aggr is
             Key_Type  : constant Entity_Id := Etype (Next_Formal (Container));
             Elmt_Type : constant Entity_Id :=
                                  Etype (Next_Formal (Next_Formal (Container)));
-            Comp   : Node_Id;
-            Choice : Node_Id;
+
+            Comp_Assocs : constant List_Id := Component_Associations (N);
+            Comp        : Node_Id;
+            Choice      : Node_Id;
 
          begin
-            Comp := First (Component_Associations (N));
+            --  In the Add_Named case, the aggregate must consist of named
+            --  associations (Add_Unnnamed is not allowed), so we issue an
+            --  error if there are positional associations.
+
+            if not Present (Comp_Assocs)
+              and then Present (Expressions (N))
+            then
+               Error_Msg_N ("container aggregate must be "
+                 & "named, not positional", N);
+               return;
+            end if;
+
+            Comp := First (Comp_Assocs);
             while Present (Comp) loop
                if Nkind (Comp) = N_Component_Association then
                   Choice := First (Choices (Comp));
-- 
2.43.0