]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Fix wrong resolution for hidden discriminant in predicate
authorEric Botcazou <ebotcazou@adacore.com>
Sun, 2 Jul 2023 22:33:18 +0000 (00:33 +0200)
committerMarc Poulhiès <poulhies@adacore.com>
Tue, 11 Jul 2023 09:24:28 +0000 (11:24 +0200)
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.

gcc/ada/sem_ch13.adb

index c3ea8d63566a123dacef43fbbe5cb850782574d6..4f97094aae53e0f6e17b17ab609cb2768f6c18d1 100644 (file)
@@ -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