[gcc r12-2200] [Ada] Inconsistency between declaration and body of predicate functions

[gcc r12-2200] [Ada] Inconsistency between declaration and body of predicate functions

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:e347e6c92769196408720a027618bc67450abe61

commit r12-2200-ge347e6c92769196408720a027618bc67450abe61
Author: Arnaud Charlet <charlet@adacore.com>
Date:   Mon May 10 11:29:08 2021 -0400

    [Ada] Inconsistency between declaration and body of predicate functions
    
    gcc/ada/
    
            * sem_ch13.adb (Resolve_Aspect_Expressions): Use the same
            processing for Predicate, Static_Predicate and
            Dynamic_Predicate. Do not build the predicate function spec.
            Update comments.
            (Resolve_Name): Only reset Entity when necessary to avoid
            spurious visibility errors.
            (Check_Aspect_At_End_Of_Declarations): Handle consistently all
            Predicate aspects.
            * sem_ch3.adb (Analyze_Subtype_Declaration): Fix handling of
            private types with predicates.

Diff:
---
 gcc/ada/sem_ch13.adb | 43 ++++++++++++++++++++++++++-----------------
 gcc/ada/sem_ch3.adb  | 11 ++++++++++-
 2 files changed, 36 insertions(+), 18 deletions(-)

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 0359625465d..f0962ca0e24 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -10114,11 +10114,11 @@ package body Sem_Ch13 is
       then
          return;
 
-        --  Do not generate predicate bodies within a generic unit. The
-        --  expressions have been analyzed already, and the bodies play
-        --  no role if not within an executable unit. However, if a static
-        --  predicate is present it must be processed for legality checks
-        --  such as case coverage in an expression.
+      --  Do not generate predicate bodies within a generic unit. The
+      --  expressions have been analyzed already, and the bodies play no role
+      --  if not within an executable unit. However, if a static predicate is
+      --  present it must be processed for legality checks such as case
+      --  coverage in an expression.
 
       elsif Inside_A_Generic
         and then not Has_Static_Predicate_Aspect (Typ)
@@ -10782,7 +10782,9 @@ package body Sem_Ch13 is
          --  also make its potential components accessible.
 
          if not Analyzed (Freeze_Expr) and then Inside_A_Generic then
-            if A_Id in Aspect_Dynamic_Predicate | Aspect_Predicate then
+            if A_Id in Aspect_Dynamic_Predicate | Aspect_Predicate |
+                       Aspect_Static_Predicate
+            then
                Push_Type (Ent);
                Preanalyze_Spec_Expression (Freeze_Expr, Standard_Boolean);
                Pop_Type (Ent);
@@ -10813,6 +10815,7 @@ package body Sem_Ch13 is
             if A_Id in Aspect_Dynamic_Predicate
                      | Aspect_Predicate
                      | Aspect_Priority
+                     | Aspect_Static_Predicate
             then
                Push_Type (Ent);
                Check_Aspect_At_Freeze_Point (ASN);
@@ -10840,6 +10843,7 @@ package body Sem_Ch13 is
                      | Aspect_Dynamic_Predicate
                      | Aspect_Predicate
                      | Aspect_Priority
+                     | Aspect_Static_Predicate
          then
             Push_Type (Ent);
             Preanalyze_Spec_Expression (End_Decl_Expr, T);
@@ -15042,9 +15046,15 @@ package body Sem_Ch13 is
                       or else N /= Selector_Name (Parent (N)))
          then
             Find_Direct_Name (N);
-            Set_Entity (N, Empty);
 
-         --  The name is component association needs no resolution
+            --  Reset the Entity if N is overloaded since the entity may not
+            --  be the correct one.
+
+            if Is_Overloaded (N) then
+               Set_Entity (N, Empty);
+            end if;
+
+         --  The name in a component association needs no resolution
 
          elsif Nkind (N) = N_Component_Association then
             Dummy := Resolve_Name (Expression (N));
@@ -15087,24 +15097,23 @@ package body Sem_Ch13 is
                   --  types. These will require special handling???.
 
                   when Aspect_Invariant
-                     | Aspect_Predicate
                      | Aspect_Predicate_Failure
                   =>
                      null;
 
                   when Aspect_Dynamic_Predicate
                      | Aspect_Static_Predicate
+                     | Aspect_Predicate
                   =>
-                     --  Build predicate function specification and preanalyze
-                     --  expression after type replacement. The function
-                     --  declaration must be analyzed in the scope of the type,
-                     --  but the expression can reference components and
-                     --  discriminants of the type.
+                     --  Preanalyze expression after type replacement to catch
+                     --  name resolution errors if the predicate function has
+                     --  not been built yet.
+                     --  Note that we cannot use Preanalyze_Spec_Expression
+                     --  because of the special handling required for
+                     --  quantifiers, see comments on Resolve_Aspect_Expression
+                     --  above.
 
                      if No (Predicate_Function (E)) then
-                        Discard_Node
-                          (Build_Predicate_Function_Declaration (E));
-
                         Push_Type (E);
                         Resolve_Aspect_Expression (Expr);
                         Pop_Type (E);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 29664920f82..e9b445619ea 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5779,7 +5779,16 @@ package body Sem_Ch3 is
           ((In_Instance and then not Comes_From_Source (N))
              or else No (Aspect_Specifications (N)))
       then
-         Set_Subprograms_For_Type (Id, Subprograms_For_Type (T));
+         --  Inherit Subprograms_For_Type from the full view, if present
+
+         if Present (Full_View (T))
+           and then Subprograms_For_Type (Full_View (T)) /= No_Elist
+         then
+            Set_Subprograms_For_Type
+              (Id, Subprograms_For_Type (Full_View (T)));
+         else
+            Set_Subprograms_For_Type (Id, Subprograms_For_Type (T));
+         end if;
 
          --  If the current declaration created both a private and a full view,
          --  then propagate Predicate_Function to the latter as well.