From: Eric Botcazou <ebotcazou@adacore.com>
Date: Fri, 19 Dec 2025 17:24:45 +0000 (+0100)
Subject: ada: Fix fallout of latest accessibility change with -gnata
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=5c1228d38b3215bc0c22229b4bc834abc1f11055;p=thirdparty%2Fgcc.git

ada: Fix fallout of latest accessibility change with -gnata

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.
---

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