From: Eric Botcazou <[email protected]>
Compiling with assertion enabled may create _Wrapped_Statements functions
with access result, whose anonymous access result type is the same entity
as that of their parent function, which fools the accessibility logic.
gcc/ada/ChangeLog:
* accessibility.adb (Function_Call_Or_Allocator_Level): Adjust the
latest change to cope with _Wrapped_Statements functions.
* einfo.ads (Wrapped_Statements): Fix description.
* sem_util.adb (In_Return_Value): Fix typo in comment.
Tested on x86_64-pc-linux-gnu (before the recent bootstrap breakage), committed
on master.
---
gcc/ada/accessibility.adb | 11 ++++++++++-
gcc/ada/einfo.ads | 2 +-
gcc/ada/sem_util.adb | 2 +-
3 files changed, 12 insertions(+), 3 deletions(-)
diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb
index 1e2dcbb475b..c3e69d45db5 100644
--- a/gcc/ada/accessibility.adb
+++ b/gcc/ada/accessibility.adb
@@ -577,8 +577,17 @@ package body Accessibility is
-- formal parameter in a return context and we return the library
-- level to null them out there.
+ -- Note that we have to deal specifically with _Wrapped_Statements
+ -- functions of functions returning an access result, generated by
+ -- the expansion of contracts and postconditions, because they get
+ -- the same anonymous access result type as their parent function.
+
if Is_Explicitly_Aliased (E)
- and then Scope (E) = Current_Subprogram
+ and then (Scope (E) = Current_Subprogram
+ or else (Has_Expanded_Contract (Scope (E))
+ and then
+ Wrapped_Statements (Scope (E)) =
+ Current_Subprogram))
and then (In_Return_Value (Expr) or else In_Return_Context)
then
return Make_Level_Literal (Scope_Depth (Standard_Standard));
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 357634a7ed5..63bfb7ca6da 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -4860,7 +4860,7 @@ package Einfo is
-- Wrapped_Statements
-- Defined in functions, procedures, entries, and entry families. Refers
--- to the entity of the _Wrapped_Statements procedure, which gets
+-- to the entity of the _Wrapped_Statements subprogram, which gets
-- generated as part of the expansion of contracts and postconditions
-- and contains its enclosing subprogram's original source declarations
-- and statements.
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index c44af46ced5..bca32ffec11 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -14774,7 +14774,7 @@ package body Sem_Util is
-- Start of processing for In_Return_Value
begin
- -- Move through parent nodes to determine if Expr contributes to the
+ -- Move through parent nodes to determine if Exp contributes to the
-- return value of the current subprogram.
Parent_Loop : while Present (P) loop
--
2.51.0
