We need to declare a predicate function along with its type but can only
generate the body at freeze point which may be in a separate scope,
leading to inconsistencies. So fix this by deferring the generation of
the predicate function declaration and fix latent bugs uncovered along
the way.
While investigating we also discovered inconsistencies among the 3
predicate related aspects, partly fixed here.
Tested on x86_64-pc-linux-gnu, committed on trunk
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 --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
--- 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
--- 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.
