[gcc r13-7896] ada: Fix wrong resolution for hidden discriminant in predicate

[gcc r13-7896] ada: Fix wrong resolution for hidden discriminant in predicate

[Eric Botcazou]

https://gcc.gnu.org/g:864411ef7ce8f4e1a1f931fb8474d10412c0636d

commit r13-7896-g864411ef7ce8f4e1a1f931fb8474d10412c0636d
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Mon Jul 3 00:33:18 2023 +0200

    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.

Diff:
---
 gcc/ada/sem_ch13.adb | 49 ++++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 42 insertions(+), 7 deletions(-)

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index cead44c52a1..d66255cdd9e 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -15439,15 +15439,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
@@ -15461,6 +15457,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