[gcc r16-8049] Ada: Fix missing accessibility check in assignment for aliased parameter

[Eric Botcazou]

https://gcc.gnu.org/g:2c4a65aef9cf7f1d4359ba5897b36d96823eb59e

commit r16-8049-g2c4a65aef9cf7f1d4359ba5897b36d96823eb59e
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Thu Mar 12 17:58:41 2026 +0100

    Ada: Fix missing accessibility check in assignment for aliased parameter
    
    This plugs a loophole related to static accessibility checks in assignment
    for aliased parameters.
    
    gcc/ada/
            PR ada/124376
            * sem_res.adb (Resolve_Actuals.Check_Aliased_Parameter): Deal with
            assignment statements.
    
    gcc/testsuite/
            * gnat.dg/aliased3.adb: New test.

Diff:
---
 gcc/ada/sem_res.adb                | 10 +++++++++-
 gcc/testsuite/gnat.dg/aliased3.adb | 18 ++++++++++++++++++
 2 files changed, 27 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 43ff97cd8c82..688347ba1aa4 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;
diff --git a/gcc/testsuite/gnat.dg/aliased3.adb b/gcc/testsuite/gnat.dg/aliased3.adb
new file mode 100644
index 000000000000..16355a909134
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/aliased3.adb
@@ -0,0 +1,18 @@
+-- { 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;