[COMMITTED] ada: Fix wrong resolution for hidden discriminant in predicate
Checks
Commit Message
From: Eric Botcazou <ebotcazou@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_ch13.adb | 49 +++++++++++++++++++++++++++++++++++++-------
1 file changed, 42 insertions(+), 7 deletions(-)
@@ -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