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