===================================================================
@@ -11588,6 +11588,12 @@
if Ekind (Subp) = E_Procedure and then Is_Null_Init_Proc (Subp) then
return;
+
+ -- Within a predicate function we do not want to generate local
+ -- subtypes that may generate nested predicate functions.
+
+ elsif Is_Subprogram (Subp) and then Is_Predicate_Function (Subp) then
+ return;
end if;
-- The subtype declarations may freeze the formals. The body generated
===================================================================
@@ -8700,6 +8700,9 @@
FBody : Node_Id;
begin
+ Set_Ekind (SIdB, E_Function);
+ Set_Is_Predicate_Function (SIdB);
+
-- The predicate function is shared between views of a type
if Is_Private_Type (Typ) and then Present (Full_View (Typ)) then
@@ -12664,6 +12667,7 @@
------------------
function Resolve_Name (N : Node_Id) return Traverse_Result is
+ Dummy : Traverse_Result;
begin
if Nkind (N) = N_Selected_Component then
if Nkind (Prefix (N)) = N_Identifier
@@ -12681,6 +12685,12 @@
Set_Entity (N, Empty);
end if;
+ -- The name is component association needs no resolution.
+
+ elsif Nkind (N) = N_Component_Association then
+ Dummy := Resolve_Name (Expression (N));
+ return Skip;
+
elsif Nkind (N) = N_Quantified_Expression then
return Skip;
end if;
@@ -12722,14 +12732,19 @@
| Aspect_Static_Predicate
=>
-- Build predicate function specification and preanalyze
- -- expression after type replacement.
+ -- expression after type replacement. The function
+ -- declaration must be analyzed in the scope of the
+ -- type, but the expression must see components.
if No (Predicate_Function (E)) then
+ Uninstall_Discriminants_And_Pop_Scope (E);
declare
FDecl : constant Node_Id :=
Build_Predicate_Function_Declaration (E);
pragma Unreferenced (FDecl);
+
begin
+ Push_Scope_And_Install_Discriminants (E);
Resolve_Aspect_Expression (Expr);
end;
end if;
This patch fixes spurious visibility errors on the expression for a dynamic predicate in a subtype declaration, when the enclosing package includes private declarations. The following packages much compile quietly: --- package foo is type Kind_Type is (None, Known); type Auction_State_Type (Kind : Kind_Type) is record case Kind is when None => null; when Known => Bar : Integer; end case; end record; Null_Auction_State : constant Auction_State_Type; subtype Not_Null_Auction_State_Type is Auction_State_Type with Dynamic_Predicate => Not_Null_Auction_State_Type /= Auction_State_Type'(Kind => None); private Null_Auction_State : constant Auction_State_Type := (Kind => None); hing : Integer := 13; end foo; --- package TD is type T (N : Natural) is private; function Is_Null (X : T) return Boolean; subtype Not_Null_T is T with Dynamic_Predicate => not Is_Null (Not_Null_T); private type T (N : Natural) is null record; function Is_Null (X : T) return Boolean is (X.N = 0); end; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-09-07 Ed Schonberg <schonberg@adacore.com> * sem_ch6.adb (setr_Actual_Subtypes): Within a predicate function do not create actual subtypes that may generate further predicate functions. * sem_ch13.adb (Build_Predicate_Functions): Indicate that entity of body is a predicate function as well. (Resolve_Aspect_Expressions, Resolve_Name): For a component association, only the expression needs resolution, not the name. (Resolve_Aspect_Expressions, case Predicates): Construct and analyze the predicate function declaration in the scope of the type, before making the type and its discriminants visible.