ada: Fix internal error on quantified expression with predicated type

The problem is that the special function created by the compiler to check
the predicate does not inherit the public status of the type, because it
is generated as part of the freezing of the quantified expression, which
occurs from within a couple of intermediate internal scopes.

gcc/ada/

	* sem_ch13.adb (Build_Predicate_Function_Declaration): Adjust the
	commentary to the current implementation.
	* sem_util.ads (Current_Scope_No_Loops): Move around.
	(Current_Scope_No_Loops_No_Blocks): New declaration.
	(Add_Block_Identifier): Fix formatting.
	* sem_util.adb (Add_Block_Identifier): Likewise.
	(Current_Scope_No_Loops_No_Blocks): New function.
	(Set_Public_Status): Call Current_Scope_No_Loops_No_Blocks instead
	of Current_Scope to get the current scope.

3 files changed, 40 insertions, 14 deletions

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 9ece773..d1458f5 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -133,9 +133,7 @@ package body Sem_Ch13 is
    function Build_Predicate_Function_Declaration
       (Typ : Entity_Id) return Node_Id;
    --  Build the declaration for a predicate function. The declaration is built
-   --  at the end of the declarative part containing the type definition, which
-   --  may be before the freeze point of the type. The predicate expression is
-   --  preanalyzed at this point, to catch visibility errors.
+   --  at the same time as the body but inserted before, as explained below.
 
    procedure Build_Predicate_Function (Typ : Entity_Id; N : Node_Id);
    --  If Typ has predicates (indicated by Has_Predicates being set for Typ),
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 391cade..c8599d4 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -312,11 +312,12 @@ package body Sem_Util is
    --------------------------
 
    procedure Add_Block_Identifier
-       (N : Node_Id;
-        Id : out Entity_Id;
-        Scope : Entity_Id := Current_Scope)
+     (N     : Node_Id;
+      Id    : out Entity_Id;
+      Scope : Entity_Id := Current_Scope)
    is
       Loc : constant Source_Ptr := Sloc (N);
+
    begin
       pragma Assert (Nkind (N) = N_Block_Statement);
 
@@ -331,7 +332,6 @@ package body Sem_Util is
          Id := New_Internal_Entity (E_Block, Scope, Loc, 'B');
          Set_Etype  (Id, Standard_Void_Type);
          Set_Parent (Id, N);
-
          Set_Identifier (N, New_Occurrence_Of (Id, Loc));
          Set_Block_Node (Id, Identifier (N));
       end if;
@@ -6721,6 +6721,31 @@ package body Sem_Util is
       return S;
    end Current_Scope_No_Loops;
 
+   --------------------------------------
+   -- Current_Scope_No_Loops_No_Blocks --
+   --------------------------------------
+
+   function Current_Scope_No_Loops_No_Blocks return Entity_Id is
+      S : Entity_Id;
+
+   begin
+      --  Examine the scope stack starting from the current scope and skip any
+      --  internally generated loops and blocks.
+
+      S := Current_Scope;
+      while Present (S) and then S /= Standard_Standard loop
+         if Ekind (S) in E_Loop | E_Block
+           and then not Comes_From_Source (S)
+         then
+            S := Scope (S);
+         else
+            exit;
+         end if;
+      end loop;
+
+      return S;
+   end Current_Scope_No_Loops_No_Blocks;
+
    ------------------------
    -- Current_Subprogram --
    ------------------------
@@ -27724,7 +27749,7 @@ package body Sem_Util is
    -----------------------
 
    procedure Set_Public_Status (Id : Entity_Id) is
-      S : constant Entity_Id := Current_Scope;
+      S : constant Entity_Id := Current_Scope_No_Loops_No_Blocks;
 
       function Within_HSS_Or_If (E : Entity_Id) return Boolean;
       --  Determines if E is defined within handled statement sequence or
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 7bb8cdb..3edc158 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -639,18 +639,21 @@ package Sem_Util is
    function Current_Scope return Entity_Id;
    --  Get entity representing current scope
 
+   function Current_Scope_No_Loops return Entity_Id;
+   --  Return the current scope ignoring internally generated loops
+
+   function Current_Scope_No_Loops_No_Blocks return Entity_Id;
+   --  Return the current scope ignoring internally generated loops and blocks
+
    procedure Add_Block_Identifier
-       (N : Node_Id;
-        Id : out Entity_Id;
-        Scope : Entity_Id := Current_Scope);
+     (N     : Node_Id;
+      Id    : out Entity_Id;
+      Scope : Entity_Id := Current_Scope);
    --  Given a block statement N, generate an internal E_Block label and make
    --  it the identifier of the block. Scope denotes the scope in which the
    --  generated entity Id is created and defaults to the current scope. If the
    --  block already has an identifier, Id returns the entity of its label.
 
-   function Current_Scope_No_Loops return Entity_Id;
-   --  Return the current scope ignoring internally generated loops
-
    function Current_Subprogram return Entity_Id;
    --  Returns current enclosing subprogram. If Current_Scope is a subprogram,
    --  then that is what is returned, otherwise the Enclosing_Subprogram of the