This plugs a loophole related to static accessibility checks in assignment for 
aliased parameters.  Tested on x86-64/Linux, applied on the mainline.


2026-03-12  Eric Botcazou  <[email protected]>

        PR ada/124376
        * sem_res.adb (Resolve_Actuals.Check_Aliased_Parameter): Deal with
        assignment statements.


2026-03-12  Eric Botcazou  <[email protected]>

        * gnat.dg/aliased3.adb: New test.

-- 
Eric Botcazou
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 43ff97cd8c8..688347ba1aa 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -3799,6 +3799,14 @@ package body Sem_Res is
             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)
+            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))))
@@ -3810,7 +3818,7 @@ package body Sem_Res is
               and then Comes_From_Source (N)
               and then Subprogram_Access_Level (Current_Subprogram)
                          < Static_Accessibility_Level
-                            (A, Object_Decl_Level, In_Return_Context => True)
+                             (A, Object_Decl_Level, In_Return_Context => True)
             then
                Accessibility_Error ("return");
             end if;
-- { dg-do compile }

procedure Aliased3 is

   function F (R : aliased Integer) return access constant Integer is
   (R'Access);

   X : access constant Integer;

begin
   declare
      R : aliased Integer := 123;
      Y : access constant Integer;
   begin
      Y := F (R); -- { dg-bogus "wrong accessibility in assignment" }
      X := F (R); -- { dg-error "wrong accessibility in assignment" }
   end;
end;

Reply via email to