From: Steve Baird <[email protected]>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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 eb7422c8c7a..0fd668413ac 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 =>
--
2.43.0
