From: Eric Botcazou <ebotcazou@adacore.com>
Date: Sat, 16 May 2026 12:09:54 +0000 (+0200)
Subject: ada: Disable a couple of static accessibility checks in dynamic cases
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=f0c0c86b8b2daec628705d64d7b174e25cedc3a9;p=thirdparty%2Fgcc.git

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 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;