[COMMITTED] ada: Cleanups in handling of aggregates
Commit Message
From: Piotr Trojanek <trojanek@adacore.com>
Assorted cleanups related to recent fixes of aggregate handling for
GNATprove; semantics is unaffected.
gcc/ada/
* sem_aggr.adb
(Resolve_Record_Aggregate): Remove useless assignment.
* sem_aux.adb
(Has_Variant_Part): Remove useless guard; this routine is only called
on type entities (and now will crash in other cases).
* sem_ch3.adb
(Create_Constrained_Components): Only assign Assoc_List when necessary;
tune whitespace.
(Is_Variant_Record): Refactor repeated calls to Parent.
* sem_util.adb
(Gather_Components): Assert that discriminant association has just one
choice in component_association; refactor repeated calls to Next.
* sem_util.ads
(Gather_Components): Tune whitespace in comment.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_aggr.adb | 1 -
gcc/ada/sem_aux.adb | 4 ----
gcc/ada/sem_ch3.adb | 34 ++++++++++++++++++----------------
gcc/ada/sem_util.adb | 10 ++++++----
gcc/ada/sem_util.ads | 1 -
5 files changed, 24 insertions(+), 26 deletions(-)
@@ -5674,7 +5674,6 @@ package body Sem_Aggr is
-- STEP 6: Find component Values
- Component := Empty;
Component_Elmt := First_Elmt (Components);
-- First scan the remaining positional associations in the aggregate.
@@ -728,10 +728,6 @@ package body Sem_Aux is
CList : Node_Id;
begin
- if not Is_Type (Typ) then
- return False;
- end if;
-
FSTyp := First_Subtype (Typ);
if not Has_Discriminants (FSTyp) then
@@ -15161,8 +15161,8 @@ package body Sem_Ch3 is
Loc : constant Source_Ptr := Sloc (Subt);
Comp_List : constant Elist_Id := New_Elmt_List;
Parent_Type : constant Entity_Id := Etype (Typ);
- Assoc_List : constant List_Id := New_List;
+ Assoc_List : List_Id;
Discr_Val : Elmt_Id;
Errors : Boolean;
New_C : Entity_Id;
@@ -15191,8 +15191,10 @@ package body Sem_Ch3 is
procedure Collect_Fixed_Components (Typ : Entity_Id) is
begin
- -- Build association list for discriminants, and find components of the
- -- variant part selected by the values of the discriminants.
+ -- Build association list for discriminants, and find components of
+ -- the variant part selected by the values of the discriminants.
+
+ Assoc_List := New_List;
Old_C := First_Discriminant (Typ);
Discr_Val := First_Elmt (Constraints);
@@ -15293,13 +15295,13 @@ package body Sem_Ch3 is
-----------------------
function Is_Variant_Record (T : Entity_Id) return Boolean is
+ Decl : constant Node_Id := Parent (T);
begin
- return Nkind (Parent (T)) = N_Full_Type_Declaration
- and then Nkind (Type_Definition (Parent (T))) = N_Record_Definition
- and then Present (Component_List (Type_Definition (Parent (T))))
+ return Nkind (Decl) = N_Full_Type_Declaration
+ and then Nkind (Type_Definition (Decl)) = N_Record_Definition
+ and then Present (Component_List (Type_Definition (Decl)))
and then
- Present
- (Variant_Part (Component_List (Type_Definition (Parent (T)))));
+ Present (Variant_Part (Component_List (Type_Definition (Decl))));
end Is_Variant_Record;
-- Start of processing for Create_Constrained_Components
@@ -15427,10 +15429,10 @@ package body Sem_Ch3 is
Gather_Components
(Typ,
Component_List (Type_Definition (Parent (Typ))),
- Governed_By => Assoc_List,
- Into => Comp_List,
- Report_Errors => Errors,
- Allow_Compile_Time => True);
+ Governed_By => Assoc_List,
+ Into => Comp_List,
+ Report_Errors => Errors,
+ Allow_Compile_Time => True);
pragma Assert (not Errors or else Serious_Errors_Detected > 0);
Create_All_Components;
@@ -15450,10 +15452,10 @@ package body Sem_Ch3 is
Gather_Components
(Typ,
Component_List (Type_Definition (Parent (Parent_Type))),
- Governed_By => Assoc_List,
- Into => Comp_List,
- Report_Errors => Errors,
- Allow_Compile_Time => True);
+ Governed_By => Assoc_List,
+ Into => Comp_List,
+ Report_Errors => Errors,
+ Allow_Compile_Time => True);
-- Note: previously there was a check at this point that no errors
-- were detected. As a consequence of AI05-220 there may be an error
@@ -9788,6 +9788,8 @@ package body Sem_Util is
Assoc := First (Governed_By);
Find_Constraint : loop
Discrim := First (Choices (Assoc));
+ pragma Assert (No (Next (Discrim)));
+
exit Find_Constraint when
Chars (Discrim_Name) = Chars (Discrim)
or else
@@ -9862,16 +9864,16 @@ package body Sem_Util is
end if;
end if;
- if No (Next (Assoc)) then
+ Next (Assoc);
+
+ if No (Assoc) then
Error_Msg_NE
- (" missing value for discriminant&",
+ ("missing value for discriminant&",
First (Governed_By), Discrim_Name);
Report_Errors := True;
return;
end if;
-
- Next (Assoc);
end loop Find_Constraint;
Discrim_Value := Expression (Assoc);
@@ -1080,7 +1080,6 @@ package Sem_Util is
--
-- Report_Errors is set to True if the values of the discriminants are
-- insufficiently static (see body for details of what that means).
-
--
-- Allow_Compile_Time if set to True, allows compile time known values in
-- Governed_By expressions in addition to static expressions.