From: Eric Botcazou <[email protected]>
In accordance with the RM 3.10.2(19,19.1,19.2) rules.
gcc/ada/ChangeLog:
* exp_ch4.adb (Expand_Allocator_Expression): In the case of access
discriminants, pass Zero_On_Dynamic_Level to compute the static
accessibility level of the expression.
* sem_res.adb (Check_Aliased_Parameter): Pass Zero_On_Dynamic_Level
to compute the static accessibility level of actual parameters.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch4.adb | 2 +-
gcc/ada/sem_res.adb | 24 ++++++++++++++----------
2 files changed, 15 insertions(+), 11 deletions(-)
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index dc4d3261082..b90107f09ca 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -840,7 +840,7 @@ package body Exp_Ch4 is
if Is_Entity_Name (Exp)
and then Has_Anonymous_Access_Discriminant (Etype (Exp))
- and then Static_Accessibility_Level (Exp, Object_Decl_Level)
+ and then Static_Accessibility_Level (Exp, Zero_On_Dynamic_Level)
> Static_Accessibility_Level (N, Object_Decl_Level)
then
-- A dynamic check and a warning are generated when we are within
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 680a9d683b6..9dc8afecd4f 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -3767,31 +3767,35 @@ package body Sem_Res is
elsif Ekind (Etype (Nam)) = E_Anonymous_Access_Type
and then Nkind (Parent (N)) = N_Type_Conversion
- and then Type_Access_Level (Etype (Parent (N)))
- < Static_Accessibility_Level (A, Object_Decl_Level)
+ and then
+ Type_Access_Level (Etype (Parent (N)))
+ < Static_Accessibility_Level (A, Zero_On_Dynamic_Level)
then
Accessibility_Error ("conversion");
elsif Ekind (Etype (Nam)) = E_Anonymous_Access_Type
and then Nkind (Parent (N)) = N_Assignment_Statement
- and then Static_Accessibility_Level
- (Name (Parent (N)), Object_Decl_Level)
- < Static_Accessibility_Level (A, Object_Decl_Level)
+ and then
+ Static_Accessibility_Level
+ (Name (Parent (N)), Object_Decl_Level)
+ < Static_Accessibility_Level (A, Zero_On_Dynamic_Level)
then
Accessibility_Error ("assignment");
elsif Nkind (Parent (N)) = N_Qualified_Expression
and then Nkind (Parent (Parent (N))) = N_Allocator
- and then Type_Access_Level (Etype (Parent (Parent (N))))
- < Static_Accessibility_Level (A, Object_Decl_Level)
+ and then
+ Type_Access_Level (Etype (Parent (Parent (N))))
+ < Static_Accessibility_Level (A, Zero_On_Dynamic_Level)
then
Accessibility_Error ("allocator");
elsif In_Return_Value (N)
and then Comes_From_Source (N)
- and then Subprogram_Access_Level (Current_Subprogram)
- < Static_Accessibility_Level
- (A, Object_Decl_Level, In_Return_Context => True)
+ and then
+ Subprogram_Access_Level (Current_Subprogram)
+ < Static_Accessibility_Level
+ (A, Zero_On_Dynamic_Level, In_Return_Context => True)
then
Accessibility_Error ("return");
end if;
--
2.53.0
