diff options
| author | Steve Baird <baird@adacore.com> | 2025-07-22 12:34:50 -0700 |
|---|---|---|
| committer | Marc Poulhiès <dkm@gcc.gnu.org> | 2025-08-04 15:04:10 +0200 |
| commit | 0aebb77ced3d63ff9c37ef5ad609d47b9640ede0 (patch) | |
| tree | 3ddc343771f04bd931b1cc728a9e6dd9766f7b2d | |
| parent | bad0a5c562991a8b1e515cd498347b314bc2e8a9 (diff) | |
| download | gcc-0aebb77ced3d63ff9c37ef5ad609d47b9640ede0.zip gcc-0aebb77ced3d63ff9c37ef5ad609d47b9640ede0.tar.gz gcc-0aebb77ced3d63ff9c37ef5ad609d47b9640ede0.tar.bz2 | |
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.
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 12 |
1 files changed, 11 insertions, 1 deletions
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index eb7422c..0fd6684 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 => |