https://gcc.gnu.org/g:0aebb77ced3d63ff9c37ef5ad609d47b9640ede0

commit r16-2753-g0aebb77ced3d63ff9c37ef5ad609d47b9640ede0
Author: Steve Baird <ba...@adacore.com>
Date:   Tue Jul 22 12:34:50 2025 -0700

    ada: Implement accessibility legality check for discriminated function 
result.
    
    If a function result type has an access discriminant, then we already
    generate a run-time accessibility check for a return statement. But if
    we know statically that the check (if executed) is going to fail, then
    that should be rejected at compile-time as a violation of RM 6.5(5.9).
    Add this additional compile-time check.
    
    gcc/ada/ChangeLog:
    
            * exp_ch6.adb (Apply_Access_Discrims_Accessibility_Check): If the
            accessibility level being checked is known statically, then
            statically check it against the level of the function being
            returned from.

Diff:
---
 gcc/ada/exp_ch6.adb | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index eb7422c8c7a8..0fd668413ac0 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -921,7 +921,8 @@ package body Exp_Ch6 is
      --  in accessibility.adb (which can cause the extra formal parameter
      --  needed for the check(s) generated here to be missing in the case
      --  of a tagged result type); this is a workaround and can
-     --  prevent generation of a required check.
+     --  prevent generation of a required check (or even a required
+     --  legality check - see "statically too deep" check below).
 
       if No (Extra_Accessibility_Of_Result (Func)) then
          return;
@@ -969,6 +970,15 @@ package body Exp_Ch6 is
                     Accessibility_Level (Discr_Exp, Level => Dynamic_Level);
                   Analyze (Discrim_Level);
 
+                  if Nkind (Discrim_Level) = N_Integer_Literal
+                    and then Intval (Discrim_Level) > Scope_Depth (Func)
+                  then
+                     Error_Msg_N
+                        ("level of type of access discriminant value of "
+                         & "return expression is statically too deep",
+                         Enclosing_Declaration_Or_Statement (Exp));
+                  end if;
+
                   Insert_Action (Exp,
                     Make_Raise_Program_Error (Loc,
                       Condition =>

Reply via email to