Patchwork [Ada] Accessibility violated when selecting access component from function call

login
register
mail settings
Submitter Arnaud Charlet
Date June 18, 2010, 8:51 a.m.
Message ID <20100618085142.GA11166@adacore.com>
Download mbox | patch
Permalink /patch/56151/
State New
Headers show

Comments

Arnaud Charlet - June 18, 2010, 8:51 a.m.
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.

Patch

Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 160959)
+++ sem_util.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          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