[Ada] Ada 2012 accessibility checking

Message ID 20110906082804.GA19824@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Sept. 6, 2011, 8:28 a.m.
In addition to fixing some bugs, the major effect of this set of
changes is to temporarily disable support for AI05-0234's rules about how
the accessibility level of a function result object may be determined
by the point of call.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-09-06  Steve Baird  <baird@adacore.com>

	* exp_ch4.adb (Expand_Allocator_Expression): Look through
	derived subprograms in checking for presence of an
	Extra_Accessibility_Of_Result formal parameter.
	* exp_ch6.adb (Expand_Call): Look through derived subprograms in
	checking for presence of an Extra_Accessibility_Of_Result formal
	(Expand_Call.Add_Actual_Parameter): Fix a bug in the
	case where the Parameter_Associatiations attribute is already set,
	but set to an empty list.
	Unconditionally return False. This is a temporary
	change, disabling the Extra_Accessibility_Of_Result
	(Expand_Simple_Function_Return): Check for
	Extra_Accessibility_Of_Result parameter's presence instead of
	testing Ada_Version when generating a runtime accessibility
	check which makes use of the parameter.


Index: exp_ch4.adb
--- exp_ch4.adb	(revision 178570)
+++ exp_ch4.adb	(working copy)
@@ -783,6 +783,8 @@ 
                Subp := Entity (Name (Exp));
             end if;
+            Subp := Ultimate_Alias (Subp);
             if Present (Extra_Accessibility_Of_Result (Subp)) then
                  (Subprogram_Call => Exp,
Index: exp_ch6.adb
--- exp_ch6.adb	(revision 178569)
+++ exp_ch6.adb	(working copy)
@@ -1847,8 +1847,10 @@ 
             if No (Prev) then
                if No (Parameter_Associations (Call_Node)) then
                   Set_Parameter_Associations (Call_Node, New_List);
-                  Append (Insert_Param, Parameter_Associations (Call_Node));
                end if;
+               Append (Insert_Param, Parameter_Associations (Call_Node));
                Insert_After (Prev, Insert_Param);
             end if;
@@ -2754,7 +2756,8 @@ 
       --  passed in to it, then pass it in.
       if Ekind_In (Subp, E_Function, E_Operator, E_Subprogram_Type)
-         and then Present (Extra_Accessibility_Of_Result (Subp))
+        and then
+          Present (Extra_Accessibility_Of_Result (Ultimate_Alias (Subp)))
             Ancestor : Node_Id := Parent (Call_Node);
@@ -2763,15 +2766,19 @@ 
             --  Unimplemented: if Subp returns an anonymous access type, then
             --    a) if the call is the operand of an explict conversion, then
             --       the target type of the conversion (a named access type)
             --       determines the accessibility level pass in;
             --    b) if the call defines an access discriminant of an object
             --       (e.g., the discriminant of an object being created by an
             --       allocator, or the discriminant of a function result),
             --       then the accessibility level to pass in is that of the
             --       discriminated object being initialized).
+            --  ???
             while Nkind (Ancestor) = N_Qualified_Expression
                Ancestor := Parent (Ancestor);
@@ -2851,7 +2858,9 @@ 
                              Scope_Depth (Current_Scope) + 1);
                end if;
-               Add_Extra_Actual (Level, Extra_Accessibility_Of_Result (Subp));
+               Add_Extra_Actual
+                 (Level,
+                  Extra_Accessibility_Of_Result (Ultimate_Alias (Subp)));
             end if;
       end if;
@@ -6742,7 +6751,7 @@ 
       --  ensure that the function result does not outlive an
       --  object designated by one of it discriminants.
-      if Ada_Version >= Ada_2012
+      if Present (Extra_Accessibility_Of_Result (Scope_Id))
         and then Has_Unconstrained_Access_Discriminants (R_Type)
@@ -8320,6 +8329,9 @@ 
          return False;
       end Has_Unconstrained_Access_Discriminant_Component;
+      Feature_Disabled : constant Boolean := True;
+      --  Temporary
    --  Start of processing for Needs_Result_Accessibility_Level
@@ -8328,6 +8340,9 @@ 
       if not Present (Func_Typ) then
          return False;
+      elsif Feature_Disabled then
+         return False;
       --  False if not a function, also handle enum-lit renames case
       elsif Func_Typ = Standard_Void_Type