From: Eric Botcazou <ebotca...@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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 d1458f58784..983f877e001 100644
--- 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 22dc9376b92..9a0197cb45c 100644
--- 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 3edc158c749..253d1dadeee 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;
--
2.40.0
