From: Eric Botcazou <ebotcazou@adacore.com>
Date: Thu, 18 Dec 2025 23:57:28 +0000 (+0100)
Subject: ada: Fix accessibility level of function calls in Ada 95
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=867f8899e404195ae80103bb18e367f96eefa098;p=thirdparty%2Fgcc.git

ada: Fix accessibility level of function calls in Ada 95

This fixes the computation of the accessibility level in the default case.

gcc/ada/ChangeLog:

	* accessibility.adb (Function_Call_Or_Allocator_Level): Return the
	level of the subprogram in Ada 95 only in the case where the result
	type is a return-by-reference type.
---

diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb
index c3e69d45db5..6f4ff93fc12 100644
--- a/gcc/ada/accessibility.adb
+++ b/gcc/ada/accessibility.adb
@@ -258,21 +258,32 @@ package body Accessibility is
          Par      : Node_Id;
          Prev_Par : Node_Id;
       begin
-         --  Results of functions are objects, so we either get the
-         --  accessibility of the function or, in case of a call which is
-         --  indirect, the level of the access-to-subprogram type.
-
-         --  This code looks wrong ???
+         --  First deal with function calls in Ada 95
 
          if Nkind (N) = N_Function_Call
            and then Ada_Version < Ada_2005
          then
-            if Is_Entity_Name (Name (N)) then
+            --  With a return by reference, we either get the accessibility of
+            --  the function or, in case of an indirect call, the accessibility
+            --  level of the access-to-subprogram type.
+
+            if Is_Entity_Name (Name (N))
+              and then Is_Inherently_Limited_Type (Etype (N))
+            then
                return Make_Level_Literal
                         (Subprogram_Access_Level (Entity (Name (N))));
-            else
+
+            elsif Nkind (Name (N)) = N_Explicit_Dereference
+              and then Is_Inherently_Limited_Type (Etype (N))
+            then
                return Make_Level_Literal
                         (Typ_Access_Level (Etype (Prefix (Name (N)))));
+
+            --  Otherwise the accessibility level of the innermost master
+
+            else
+               return Make_Level_Literal
+                        (Innermost_Master_Scope_Depth (Expr));
             end if;
 
          --  We ignore coextensions as they cannot be implemented under the