From 5c726f3e42e227fdca32289e99b815988c40481a Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 12 Dec 2019 22:14:54 +0100 Subject: [PATCH] [Ada] Fix bogus error for clause on derived type with variant part 2020-06-02 Eric Botcazou gcc/ada/ * sem_ch3.adb (Replace_Components): Rename into... (Replace_Discriminants): ...this. Replace girder discriminants with non-girder ones. Do not replace components. * sem_ch13.adb (Check_Record_Representation_Clause): Deal with non-girder discriminants correctly. --- gcc/ada/sem_ch13.adb | 6 ++++- gcc/ada/sem_ch3.adb | 59 ++++++++++++++++++++++---------------------- 2 files changed, 35 insertions(+), 30 deletions(-) diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 5944ba5453d2..6287434426eb 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -10862,6 +10862,8 @@ package body Sem_Ch13 is end if; -- Outer level of record definition, check discriminants + -- but be careful not to flag a non-girder discriminant + -- and the girder discriminant it renames as overlapping. if Nkind_In (Clist, N_Full_Type_Declaration, N_Private_Type_Declaration) @@ -10870,7 +10872,9 @@ package body Sem_Ch13 is C2_Ent := First_Discriminant (Defining_Identifier (Clist)); while Present (C2_Ent) loop - exit when C1_Ent = C2_Ent; + exit when + Original_Record_Component (C1_Ent) = + Original_Record_Component (C2_Ent); Check_Component_Overlap (C1_Ent, C2_Ent); Next_Discriminant (C2_Ent); end loop; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 956c92ddfe20..f965e8ca6cf4 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -657,14 +657,22 @@ package body Sem_Ch3 is -- declaration, Prev_T is the original incomplete type, whose full view is -- the record type. - procedure Replace_Components (Typ : Entity_Id; Decl : Node_Id); - -- Subsidiary to Build_Derived_Record_Type. For untagged records, we - -- build a copy of the declaration tree of the parent, and we create - -- independently the list of components for the derived type. Semantic - -- information uses the component entities, but record representation - -- clauses are validated on the declaration tree. This procedure replaces - -- discriminants and components in the declaration with those that have - -- been created by Inherit_Components. + procedure Replace_Discriminants (Typ : Entity_Id; Decl : Node_Id); + -- Subsidiary to Build_Derived_Record_Type. For untagged record types, we + -- first create the list of components for the derived type from that of + -- the parent by means of Inherit_Components and then build a copy of the + -- declaration tree of the parent with the help of the mapping returned by + -- Inherit_Components, which will for example by used to validate record + -- representation claused given for the derived type. If the parent type + -- is private and has discriminants, the ancestor discriminants used in the + -- inheritance are that of the private declaration, whereas the ancestor + -- discriminants present in the declaration tree of the parent are that of + -- the full declaration; as a consequence, the remapping done during the + -- copy will leave the references to the ancestor discriminants unchanged + -- in the declaration tree and they need to be fixed up. If the derived + -- type has a known discriminant part, then the remapping done during the + -- copy will only create references to the girder discriminants and they + -- need to be replaced with references to the non-girder discriminants. procedure Set_Fixed_Range (E : Entity_Id; @@ -9628,7 +9636,7 @@ package body Sem_Ch3 is Set_Stored_Constraint (Derived_Type, Expand_To_Stored_Constraint (Parent_Type, Discs)); - Replace_Components (Derived_Type, New_Decl); + Replace_Discriminants (Derived_Type, New_Decl); end if; -- Insert the new derived type declaration @@ -22292,11 +22300,11 @@ package body Sem_Ch3 is end if; end Record_Type_Definition; - ------------------------ - -- Replace_Components -- - ------------------------ + --------------------------- + -- Replace_Discriminants -- + --------------------------- - procedure Replace_Components (Typ : Entity_Id; Decl : Node_Id) is + procedure Replace_Discriminants (Typ : Entity_Id; Decl : Node_Id) is function Process (N : Node_Id) return Traverse_Result; ------------- @@ -22310,7 +22318,9 @@ package body Sem_Ch3 is if Nkind (N) = N_Discriminant_Specification then Comp := First_Discriminant (Typ); while Present (Comp) loop - if Chars (Comp) = Chars (Defining_Identifier (N)) then + if Original_Record_Component (Comp) = Defining_Identifier (N) + or else Chars (Comp) = Chars (Defining_Identifier (N)) + then Set_Defining_Identifier (N, Comp); exit; end if; @@ -22321,24 +22331,15 @@ package body Sem_Ch3 is elsif Nkind (N) = N_Variant_Part then Comp := First_Discriminant (Typ); while Present (Comp) loop - if Chars (Comp) = Chars (Name (N)) then - Set_Entity (Name (N), Comp); + if Original_Record_Component (Comp) = Entity (Name (N)) + or else Chars (Comp) = Chars (Name (N)) + then + Set_Name (N, New_Occurrence_Of (Comp, Sloc (N))); exit; end if; Next_Discriminant (Comp); end loop; - - elsif Nkind (N) = N_Component_Declaration then - Comp := First_Component (Typ); - while Present (Comp) loop - if Chars (Comp) = Chars (Defining_Identifier (N)) then - Set_Defining_Identifier (N, Comp); - exit; - end if; - - Next_Component (Comp); - end loop; end if; return OK; @@ -22346,11 +22347,11 @@ package body Sem_Ch3 is procedure Replace is new Traverse_Proc (Process); - -- Start of processing for Replace_Components + -- Start of processing for Replace_Discriminants begin Replace (Decl); - end Replace_Components; + end Replace_Discriminants; ------------------------------- -- Set_Completion_Referenced -- -- 2.39.5