ada: Reject mixed container aggregates

A container aggregate can either be empty, contain only
positional elements or named element associations. Reject the
scenario where the latter two are both used.

gcc/ada/ChangeLog:
	* diagnostics-constructors.adb
	(Make_Mixed_Container_Aggregate_Error): New function for the error
	message
	(Record_Mixed_Container_Aggregate_Error): New function for the
	error message.
	* diagnostics-constructors.ads: Likewise.
	* diagnostics-repository.ads: register new diagnostics id
	* diagnostics.ads: add new diagnostics id
	* errout.adb (First_And_Last_Node): Detect the span for component
	associations.
	* sem_aggr.adb (Resolve_Container_Aggregate): reject container
	aggregates that have both named and positional elements.

diff --git a/gcc/ada/diagnostics-constructors.adb b/gcc/ada/diagnostics-constructors.adb
index 8a9e10a7cbef02230ed7d1be3cef25771a5fd4db..ce130cceaa2144eabad597c3bde692cc537e4820 100644 (file)
--- a/gcc/ada/diagnostics-constructors.adb
+++ b/gcc/ada/diagnostics-constructors.adb
@@ -472,4 +472,43 @@ package body Diagnostics.Constructors is
         (Make_Representation_Too_Late_Error (Rep, Freeze, Def));
    end Record_Representation_Too_Late_Error;
 
+   ------------------------------------------
+   -- Make_Mixed_Container_Aggregate_Error --
+   ------------------------------------------
+
+   function Make_Mixed_Container_Aggregate_Error
+     (Aggr       : Node_Id;
+      Pos_Elem   : Node_Id;
+      Named_Elem : Node_Id) return Diagnostic_Type
+   is
+
+   begin
+      return
+        Make_Diagnostic
+          (Msg       =>
+             "container aggregate cannot be both positional and named",
+           Location  => Primary_Labeled_Span (Aggr),
+           Id        => GNAT0011,
+           Kind      => Diagnostics.Error,
+           Spans     =>
+             (1 => Secondary_Labeled_Span
+               (Pos_Elem, "positional element "),
+             2 => Secondary_Labeled_Span
+               (Named_Elem, "named element")));
+   end Make_Mixed_Container_Aggregate_Error;
+
+   --------------------------------------------
+   -- Record_Mixed_Container_Aggregate_Error --
+   --------------------------------------------
+
+   procedure Record_Mixed_Container_Aggregate_Error
+     (Aggr       : Node_Id;
+      Pos_Elem   : Node_Id;
+      Named_Elem : Node_Id)
+   is
+   begin
+      Record_Diagnostic
+        (Make_Mixed_Container_Aggregate_Error (Aggr, Pos_Elem, Named_Elem));
+   end Record_Mixed_Container_Aggregate_Error;
+
 end Diagnostics.Constructors;

diff --git a/gcc/ada/diagnostics-constructors.ads b/gcc/ada/diagnostics-constructors.ads
index 96782b3475fbf09c730fb8bca3c9cc83100f7acf..973d176f56f29515d20f11bf83f64a7518daeec6 100644 (file)
--- a/gcc/ada/diagnostics-constructors.ads
+++ b/gcc/ada/diagnostics-constructors.ads
@@ -130,4 +130,14 @@ package Diagnostics.Constructors is
       Freeze : Node_Id;
       Def    : Node_Id);
 
+   function Make_Mixed_Container_Aggregate_Error
+     (Aggr       : Node_Id;
+      Pos_Elem   : Node_Id;
+      Named_Elem : Node_Id) return Diagnostic_Type;
+
+   procedure Record_Mixed_Container_Aggregate_Error
+     (Aggr       : Node_Id;
+      Pos_Elem   : Node_Id;
+      Named_Elem : Node_Id);
+
 end Diagnostics.Constructors;

diff --git a/gcc/ada/diagnostics-repository.ads b/gcc/ada/diagnostics-repository.ads
index b070fda026984e1378969c8373ba677d15d18cc6..ae8dc6862d66a372bc0ba1259a51851ede0352e3 100644 (file)
--- a/gcc/ada/diagnostics-repository.ads
+++ b/gcc/ada/diagnostics-repository.ads
@@ -101,6 +101,11 @@ package Diagnostics.Repository is
         (Status        => Active,
          Human_Id      => new String'("Representation_Too_Late_Error"),
          Documentation => new String'("./error_codes/GNAT0010.md"),
+         Switch        => No_Switch_Id),
+      GNAT0011         =>
+        (Status        => Active,
+         Human_Id      => new String'("Mixed_Container_Aggregate_Error"),
+         Documentation => new String'("./error_codes/GNAT0011.md"),
          Switch        => No_Switch_Id));
 
    procedure Print_Diagnostic_Repository;

diff --git a/gcc/ada/diagnostics.ads b/gcc/ada/diagnostics.ads
index 18afb1c21baf96203a23ed4513805a86730f4f69..f456927b06fe6bbeb5e1b2143e53991add923216 100644 (file)
--- a/gcc/ada/diagnostics.ads
+++ b/gcc/ada/diagnostics.ads
@@ -39,7 +39,8 @@ package Diagnostics is
       GNAT0007,
       GNAT0008,
       GNAT0009,
-      GNAT0010);
+      GNAT0010,
+      GNAT0011);
 
    --  Labeled_Span_Type represents a span of source code that is associated
    --  with a textual label. Primary spans indicate the primary location of the

diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index f4660c4e35c9f385443e3632e216c5128632bfe9..81919a3c523c081a9565b2025e16de1394d3fc21 100644 (file)
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -1869,6 +1869,8 @@ package body Errout is
                        | N_Declaration
                        | N_Access_To_Subprogram_Definition
                        | N_Generic_Instantiation
+                       | N_Component_Association
+                       | N_Iterated_Component_Association
                        | N_Later_Decl_Item
                        | N_Use_Package_Clause
                        | N_Array_Type_Definition

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 63bdeca9658496892bdcfb87e15ab4852e418049..63e17f480a439b6a82e2cec9554620a8b55ca27d 100644 (file)
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -26,6 +26,8 @@
 with Aspects;        use Aspects;
 with Atree;          use Atree;
 with Checks;         use Checks;
+with Debug;          use Debug;
+with Diagnostics.Constructors; use Diagnostics.Constructors;
 with Einfo;          use Einfo;
 with Einfo.Utils;    use Einfo.Utils;
 with Elists;         use Elists;
@@ -4051,6 +4053,21 @@ package body Sem_Aggr is
         Empty_Subp, Add_Named_Subp, Add_Unnamed_Subp,
         New_Indexed_Subp, Assign_Indexed_Subp);
 
+      if Present (First (Expressions (N)))
+        and then Present (First (Component_Associations (N)))
+      then
+         if Debug_Flag_Underscore_DD then
+            Record_Mixed_Container_Aggregate_Error
+              (Aggr       => N,
+               Pos_Elem   => First (Expressions (N)),
+               Named_Elem => First (Component_Associations (N)));
+         else
+            Error_Msg_N
+              ("container aggregate cannot be both positional and named", N);
+         end if;
+         return;
+      end if;
+
       if Present (Add_Unnamed_Subp)
         and then No (New_Indexed_Subp)
         and then Present (Etype (Add_Unnamed_Subp))
@@ -4184,14 +4201,6 @@ package body Sem_Aggr is
             if Present (Component_Associations (N))
               and then not Is_Empty_List (Component_Associations (N))
             then
-               if Present (Expressions (N))
-                 and then not Is_Empty_List (Expressions (N))
-               then
-                  Error_Msg_N ("container aggregate cannot be "
-                    & "both positional and named", N);
-                  return;
-               end if;
-
                Comp := First (Component_Associations (N));
 
                while Present (Comp) loop