ada: Rework fix for internal error on quantified expression with predicated type

It turns out that skipping compiler-generated block scopes is problematic
when computing the public status of a subprogram, because this subprogram
may end up being nested in the elaboration procedure of a package spec or
body, in which case it may not be public.

This replaces the original fix with a pair of Push_Scope/Pop_Scope in the
Build_Predicate_Function procedure, as done elsewhere in similar cases.

gcc/ada/

	* sem_ch13.adb (Build_Predicate_Functions): If the current scope
	is not that of the type, push this scope and pop it at the end.
	* sem_util.ads (Current_Scope_No_Loops_No_Blocks): Delete.
	* sem_util.adb (Current_Scope_No_Loops_No_Blocks): Likewise.
	(Set_Public_Status): Call again Current_Scope.

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index d1458f58784517c69fb8ac8b01ddc1f7c6513adf..983f877e00108b7c8aec900648fe3f90f6e498d4 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -9921,6 +9921,10 @@ package body Sem_Ch13 is
    procedure Build_Predicate_Function (Typ : Entity_Id; N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (Typ);
 
+      Saved_GM  : constant Ghost_Mode_Type := Ghost_Mode;
+      Saved_IGR : constant Node_Id         := Ignored_Ghost_Region;
+      --  Save the Ghost-related attributes to restore on exit
+
       Expr : Node_Id;
       --  This is the expression for the result of the function. It is
       --  is build by connecting the component predicates with AND THEN.
@@ -9939,6 +9943,9 @@ package body Sem_Ch13 is
       SId : Entity_Id;
       --  Its entity
 
+      Restore_Scope : Boolean;
+      --  True if the current scope must be restored on exit
+
       Ancestor_Predicate_Function_Called : Boolean := False;
       --  Does this predicate function include a call to the
       --  predication function of an ancestor subtype?
@@ -10190,12 +10197,6 @@ package body Sem_Ch13 is
          Replace_Type_References (N, Typ);
       end Replace_Current_Instance_References;
 
-      --  Local variables
-
-      Saved_GM  : constant Ghost_Mode_Type := Ghost_Mode;
-      Saved_IGR : constant Node_Id         := Ignored_Ghost_Region;
-      --  Save the Ghost-related attributes to restore on exit
-
    --  Start of processing for Build_Predicate_Function
 
    begin
@@ -10234,6 +10235,15 @@ package body Sem_Ch13 is
          return;
       end if;
 
+      --  Ensure that the declarations are added to the scope of the type
+
+      if Scope (Typ) /= Current_Scope then
+         Push_Scope (Scope (Typ));
+         Restore_Scope := True;
+      else
+         Restore_Scope := False;
+      end if;
+
       --  The related type may be subject to pragma Ghost. Set the mode now to
       --  ensure that the predicate functions are properly marked as Ghost.
 
@@ -10652,6 +10662,10 @@ package body Sem_Ch13 is
       end if;
 
       Restore_Ghost_Region (Saved_GM, Saved_IGR);
+
+      if Restore_Scope then
+         Pop_Scope;
+      end if;
    end Build_Predicate_Function;
 
    ------------------------------------------

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 22dc9376b92da19f8c52d6d8b87f445e575cad65..9a0197cb45c51e42e4a28994efdf4f652113973a 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -6722,31 +6722,6 @@ 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 --
    ------------------------
@@ -27763,7 +27738,7 @@ package body Sem_Util is
    -----------------------
 
    procedure Set_Public_Status (Id : Entity_Id) is
-      S : constant Entity_Id := Current_Scope_No_Loops_No_Blocks;
+      S : constant Entity_Id := Current_Scope;
 
       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 3edc158c74944f3182de956d1f2a77bd1de0412e..253d1dadeeed6103a66654a7870957bcf3d0bf0c 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -642,9 +642,6 @@ package Sem_Util is
    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;