diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2023-07-03 00:33:18 +0200 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2023-07-11 11:24:28 +0200 |
commit | 8957121b8bf4be7eb7f9de31b810ea01594a670e (patch) | |
tree | 825b70cf48c020fe3c2b16c8579c08a1f9f84d88 | |
parent | 312839653b8295599c63cae90278a87af528edad (diff) | |
download | gcc-8957121b8bf4be7eb7f9de31b810ea01594a670e.zip gcc-8957121b8bf4be7eb7f9de31b810ea01594a670e.tar.gz gcc-8957121b8bf4be7eb7f9de31b810ea01594a670e.tar.bz2 |
ada: Fix wrong resolution for hidden discriminant in predicate
The problem occurs for hidden discriminants of private discriminated types.
gcc/ada/
* sem_ch13.adb (Replace_Type_References_Generic.Visible_Component):
In the case of private discriminated types, return a discriminant
only if it is listed in the discriminant part of the declaration.
-rw-r--r-- | gcc/ada/sem_ch13.adb | 49 |
1 files changed, 42 insertions, 7 deletions
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index c3ea8d63..4f97094 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -15569,15 +15569,11 @@ package body Sem_Ch13 is function Visible_Component (Comp : Name_Id) return Entity_Id is E : Entity_Id; + begin - -- Types with nameable components are record, task, and protected - -- types, and discriminated private types. + -- Types with nameable components are record, task, protected types - if Ekind (T) in E_Record_Type - | E_Task_Type - | E_Protected_Type - or else (Is_Private_Type (T) and then Has_Discriminants (T)) - then + if Ekind (T) in E_Record_Type | E_Task_Type | E_Protected_Type then -- This is a sequential search, which seems acceptable -- efficiency-wise, given the typical size of component -- lists, protected operation lists, task item lists, and @@ -15591,6 +15587,45 @@ package body Sem_Ch13 is Next_Entity (E); end loop; + + -- Private discriminated types may have visible discriminants + + elsif Is_Private_Type (T) and then Has_Discriminants (T) then + declare + Decl : constant Node_Id := Declaration_Node (T); + Spec : constant List_Id := + Discriminant_Specifications (Original_Node (Decl)); + + Discr : Node_Id; + + begin + -- Loop over the discriminants listed in the discriminant part + -- of the private type declaration to find one with a matching + -- name; then, if it exists, return the discriminant entity of + -- the same name in the type, which is that of its full view. + + if Present (Spec) then + Discr := First (Spec); + + while Present (Discr) loop + if Chars (Defining_Identifier (Discr)) = Comp then + Discr := First_Discriminant (T); + + while Present (Discr) loop + if Chars (Discr) = Comp then + return Discr; + end if; + + Next_Discriminant (Discr); + end loop; + + pragma Assert (False); + end if; + + Next (Discr); + end loop; + end if; + end; end if; -- Nothing by that name |