From: Piotr Trojanek <troja...@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(-) diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index e7643277460..858ae635fc2 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -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. diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 658110f98d2..e7e096fa1cf 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -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 diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index fb4f5badd4e..ff52e05324c 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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 diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 9967bd20506..d15e20b81a7 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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); diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 4333c495ae7..6f5b20e5cf2 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -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. -- 2.40.0