[Ada] Ada 2012 accessibility checking
This set of changes implements support for AI05-0234's rules about how the accessibility level of a function result object may be determined by the point of call. The implementation involves passing in an additional accessibility-level parameter to some functions, similar in some ways to the Extra_Accessibility parameters that are already used in implementing access parameters. Initially this new parameter is only used to perform accessibility checks associated with function results which have access discriminants. Tested on x86_64-pc-linux-gnu, committed on trunk 2011-09-06 Steve Baird ba...@adacore.com * einfo.ads (Extra_Accessibility_Of_Result): New function; in the (Ada2012) cases described in AI05-0234 where the accessibility level of a function result is determined by the point of call, an implicit parameter representing that accessibility level is passed in. Extra_Accessibilty_Of_Result yields this additional formal parameter. Extra_Accessibility_Of_Result is analogous to the existing Extra_Accessibility function used in the implementation of access parameters. (Set_Extra_Accessibility_Of_Result): New procedure; sets Extra_Accessibility_Of_Result attribute. * einfo.adb (Extra_Accessibility_Of_Result): New function. (Set_Extra_Accessibility_Of_Result): New procedure. (Write_Field19_Name): Display Extra_Accessibilty_Of_Result attribute. * sem_util.adb (Dynamic_Accessibility_Level): Set Etype of an accessibility level literal to Natural; introduce a nested function, Make_Level_Literal, to do this. * exp_ch6.ads (Needs_Result_Accessibility_Level): New function; determines whether a given function (or access-to-function type) needs to have an implicitly-declared accessibility-level parameter added to its profile. (Add_Extra_Actual_To_Call): Export an existing procedure which was previously declared in the body of Exp_Ch6. * exp_ch6.adb (Add_Extra_Actual_To_Call): Export declaration by moving it to exp_ch6.ads. (Has_Unconstrained_Access_Discriminants): New Function; a predicate on subtype entities which returns True if the given subtype is unconstrained and has one or more access discriminants. (Expand_Call): When expanding a call to a function which takes an Extra_Accessibility_Of_Result parameter, pass in the appropriate actual parameter value. In the case of a function call which is used to initialize an allocator, this may not be possible because the Etype of the allocator may not have been set yet. In this case, we defer passing in the parameter and handle it later in Expand_Allocator_Expression. (Expand_Simple_Function_Return): When returning from a function which returns an unconstrained subtype having at least one access discriminant, generate the accessibility check needed to ensure that the function result will not outlive any objects designated by its discriminants. (Needs_Result_Accessibility_Level): New function; see exp_ch6.ads description. * exp_ch4.adb (Expand_Allocator_Expression): When a function call is used to initialize an allocator, we may need to pass in the accessibility level determined by the point of call (AI05-0234) to the function. Expand_Call, where such actual parameters are usually generated, is too early in this case because the Etype of the allocator (which is used in determining the level to be passed in) may not have been set yet when Expand_Call executes. Instead, we generate code to pass in the appropriate actual parameter in Expand_Allocator_Expression. * sem_ch6.adb (Create_Extra_Formals): Create the new Extra_Accessibility_Of_Result formal if Needs_Result_Accessibility_Level returns True. This includes the introduction of a nested procedure, Check_Against_Result_Level. Index: einfo.adb === --- einfo.adb (revision 178565) +++ einfo.adb (working copy) @@ -161,6 +161,7 @@ --Body_Entity Node19 --Corresponding_Discriminant Node19 + --Extra_Accessibility_Of_Result Node19 --Parent_Subtype Node19 --Related_Array_ObjectNode19 --Size_Check_Code Node19 @@ -1043,6 +1044,12 @@ return Node13 (Id); end Extra_Accessibility; + function Extra_Accessibility_Of_Result (Id : E) return E is + begin + pragma Assert (Ekind_In (Id, E_Function, E_Operator, E_Subprogram_Type)); + return Node19 (Id); + end Extra_Accessibility_Of_Result; + function Extra_Constrained (Id : E) return E is begin pragma Assert (Is_Formal (Id) or else Ekind
[Ada] Ada 2012 accessibility checking
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 ba...@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 parameter. (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. (Needs_Result_Accessibility_Level): Unconditionally return False. This is a temporary change, disabling the Extra_Accessibility_Of_Result mechanism. (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 Add_Extra_Actual_To_Call (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)); + else 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))) then declare Ancestor : Node_Id := Parent (Call_Node); @@ -2763,15 +2766,19 @@ begin -- 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 loop 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; 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) then declare @@ -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 begin @@ -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
