===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -9493,15 +9494,112 @@ package body Sem_Util is
then
return Object_Access_Level (Expression (Obj));
- -- Function results are objects, so we get either the access level of
- -- the function or, in the case of an indirect call, the level of the
- -- access-to-subprogram type.
-
elsif Nkind (Obj) = N_Function_Call then
- if Is_Entity_Name (Name (Obj)) then
- return Subprogram_Access_Level (Entity (Name (Obj)));
- else
- return Type_Access_Level (Etype (Prefix (Name (Obj))));
+
+ -- Function results are objects, so we get either the access level of
+ -- the function or, in the case of an indirect call, the level of the
+ -- access-to-subprogram type. (This code is used for Ada 95, but it
+ -- looks wrong, because it seems that we should be checking the level
+ -- of the call itself, even for Ada 95. However, using the Ada 2005
+ -- version of the code causes regressions in several tests that are
+ -- compiled with -gnat95. ???)
+
+ if Ada_Version < Ada_05 then
+ if Is_Entity_Name (Name (Obj)) then
+ return Subprogram_Access_Level (Entity (Name (Obj)));
+ else
+ return Type_Access_Level (Etype (Prefix (Name (Obj))));
+ end if;
+
+ -- For Ada 2005, the level of the result object of a function call is
+ -- defined to be the level of the call's innermost enclosing master.
+ -- We determine that by querying the depth of the innermost enclosing
+ -- dynamic scope.
+
+ else
+ Return_Master_Scope_Depth_Of_Call : declare
+
+ function Innermost_Master_Scope_Depth
+ (N : Node_Id) return Uint;
+ -- Returns the scope depth of the given node's innermost
+ -- enclosing dynamic scope (effectively the accessibility
+ -- level of the innermost enclosing master).
+
+ ----------------------------------
+ -- Innermost_Master_Scope_Depth --
+ ----------------------------------
+
+ function Innermost_Master_Scope_Depth
+ (N : Node_Id) return Uint
+ is
+ Node_Par : Node_Id := Parent (N);
+
+ begin
+ -- Locate the nearest enclosing node (by traversing Parents)
+ -- that Defining_Entity can be applied to, and return the
+ -- depth of that entity's nearest enclosing dynamic scope.
+
+ while Present (Node_Par) loop
+ case Nkind (Node_Par) is
+ when N_Component_Declaration |
+ N_Entry_Declaration |
+ N_Formal_Object_Declaration |
+ N_Formal_Type_Declaration |
+ N_Full_Type_Declaration |
+ N_Incomplete_Type_Declaration |
+ N_Loop_Parameter_Specification |
+ N_Object_Declaration |
+ N_Protected_Type_Declaration |
+ N_Private_Extension_Declaration |
+ N_Private_Type_Declaration |
+ N_Subtype_Declaration |
+ N_Function_Specification |
+ N_Procedure_Specification |
+ N_Task_Type_Declaration |
+ N_Body_Stub |
+ N_Generic_Instantiation |
+ N_Proper_Body |
+ N_Implicit_Label_Declaration |
+ N_Package_Declaration |
+ N_Single_Task_Declaration |
+ N_Subprogram_Declaration |
+ N_Generic_Declaration |
+ N_Renaming_Declaration |
+ N_Block_Statement |
+ N_Formal_Subprogram_Declaration |
+ N_Abstract_Subprogram_Declaration |
+ N_Entry_Body |
+ N_Exception_Declaration |
+ N_Formal_Package_Declaration |
+ N_Number_Declaration |
+ N_Package_Specification |
+ N_Parameter_Specification |
+ N_Single_Protected_Declaration |
+ N_Subunit =>
+
+ return Scope_Depth
+ (Nearest_Dynamic_Scope
+ (Defining_Entity (Node_Par)));
+
+ when others =>
+ null;
+ end case;
+
+ Node_Par := Parent (Node_Par);
+ end loop;
+
+ pragma Assert (False);
+
+ -- Should never reach the following return
+
+ return Scope_Depth (Current_Scope) + 1;
+ end Innermost_Master_Scope_Depth;
+
+ -- Start of processing for Return_Master_Scope_Depth_Of_Call
+
+ begin
+ return Innermost_Master_Scope_Depth (Obj);
+ end Return_Master_Scope_Depth_Of_Call;
end if;
-- For convenience we handle qualified expressions, even though
When determining the accessibility level of a function call, the compiler was using the level of the subprogram itself, instead of the level of the call's innermost enclosing master. This could result in the creation of dangling references, such as when selecting an access discriminant from a call and assigning it to an access object declared at a level not as deep as the call. When compiling for Ada 2005, we now determine the level of a call by locating the level of the innermost enclosing dynamic scope. This can't be done by simply using the level of the current scope, because cases involving renamings of function calls (or selections thereof) may result in indirect references to calls at a different level than where the renaming is referenced. The compiler must report the following error when compiling the test given below with -gnat05: call_accessibility_bug.adb:37:24: cannot convert access discriminant to non-local access type procedure Call_Accessibility_Bug is type Element_Handle (D: access Integer) is tagged limited null record; Aliased_Int : aliased Integer; function Handle return Element_Handle is begin return Element_Handle'(D => Aliased_Int'Access); end Handle; EH_0 : Element_Handle (Aliased_Int'Access); EH_1 : Element_Handle := Handle; EH_2 : Element_Handle renames Handle; Acc_Int : access Integer; begin declare EH_Renames_Outer_Object : Element_Handle renames EH_0; EH_Renames_Outer_Call_Renaming : Element_Handle renames EH_2; begin Acc_Int := EH_Renames_Outer_Object.D; -- OK Acc_Int := EH_Renames_Outer_Call_Renaming.D; -- OK Acc_Int := EH_0.D; -- OK Acc_Int := EH_1.D; -- OK Acc_Int := EH_2.D; -- OK Acc_Int := Handle.D; -- ERROR end; end Call_Accessibility_Bug; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-18 Gary Dismukes <dismukes@adacore.com> * sem_util.adb (Object_Access_Level): For Ada 2005, determine the accessibility level of a function call from the level of the innermost enclosing dynamic scope. (Innermost_Master_Scope_Depth): New function to find the depth of the nearest dynamic scope enclosing a node.