https://gcc.gnu.org/g:59f95ea220e2c8bf0ccd11227e63db82c4b37a1c

commit r16-9060-g59f95ea220e2c8bf0ccd11227e63db82c4b37a1c
Author: Eric Botcazou <[email protected]>
Date:   Sat May 16 14:09:54 2026 +0200

    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:
---
 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 6d5559a63469..ff61e492e581 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -839,7 +839,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 b5fb79a4b0f2..65734d1cf00b 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -3772,31 +3772,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;

Reply via email to