[gcc r13-7861] ada: Rework fix for internal error on quantified expression with predicated type

[gcc r13-7861] ada: Rework fix for internal error on quantified expression with predicated type

[Eric Botcazou]

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

commit r13-7861-gccd4972bbc2aece6b3d78b1ebee557e6f44a02f1
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Wed Mar 1 22:28:51 2023 +0100

    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:
---
 gcc/ada/sem_ch13.adb | 26 ++++++++++++++++++++------
 gcc/ada/sem_util.adb | 27 +--------------------------
 gcc/ada/sem_util.ads |  3 ---
 3 files changed, 21 insertions(+), 35 deletions(-)

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index d2bb758fab1..3a99c5df3a5 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -9852,6 +9852,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.
@@ -9870,6 +9874,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?
@@ -10121,12 +10128,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
@@ -10165,6 +10166,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.
 
@@ -10583,6 +10593,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 7de68a10b18..1cb17f55b96 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -6705,31 +6705,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 --
    ------------------------
@@ -27695,7 +27670,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 f53858f4886..70b50bf15f8 100644
--- 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;