https://gcc.gnu.org/g:48fd89dc4a49cf07dbde6d26c5eb39c97a0490de
commit r15-4159-g48fd89dc4a49cf07dbde6d26c5eb39c97a0490de
Author: Viljar Indus <in...@adacore.com>
Date: Wed Sep 11 11:26:05 2024 +0300
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:
---
gcc/ada/diagnostics-constructors.adb | 39 ++++++++++++++++++++++++++++++++++++
gcc/ada/diagnostics-constructors.ads | 10 +++++++++
gcc/ada/diagnostics-repository.ads | 5 +++++
gcc/ada/diagnostics.ads | 3 ++-
gcc/ada/errout.adb | 2 ++
gcc/ada/sem_aggr.adb | 25 +++++++++++++++--------
6 files changed, 75 insertions(+), 9 deletions(-)
diff --git a/gcc/ada/diagnostics-constructors.adb
b/gcc/ada/diagnostics-constructors.adb
index 8a9e10a7cbef..ce130cceaa21 100644
--- 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 96782b3475fb..973d176f56f2 100644
--- 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 b070fda02698..ae8dc6862d66 100644
--- 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 18afb1c21baf..f456927b06fe 100644
--- 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 f4660c4e35c9..81919a3c523c 100644
--- 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 63bdeca96584..63e17f480a43 100644
--- 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
