ada: Disable a couple of static accessibility checks in dynamic cases

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.

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index dc4d32610826367bd01c65668018b1fcca202aad..b90107f09cab32a36efa5018254dd7cdf874141e 100644 (file)
--- 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 680a9d683b6c2f9288b2218f8140e2d82670fc0c..9dc8afecd4f577432ec7d23470ed44314ba8b52e 100644 (file)
--- 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;