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 c3e69d45db5816bded08a2000c2c5cfcaee741be..6f4ff93fc12c267ec06d059a03b7de9d06c68491 100644 (file)
--- 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