[Ada] Implement inheritance for Default_Initial_Condition and address other gaps

gcc/ada/

	* einfo.ads (Is_Partial_DIC_Procedure): New function.
	(Partial_DIC_Procedure): New procedure.
	* einfo.adb (Is_Partial_DIC_Procedure): New function to return
	whether a subprogram is a partial Default_Initial_Condition
	procedure by checking the name (to avoid adding a new field).
	(DIC_Procedure): Add a test that excludes partial DIC procedures
	from being returned.
	(Partial_DIC_Procedure): New procedure to return the partial DIC
	procedure of a type, if it has one (otherwise returns Empty).
	(Set_DIC_Procedure): Remove check for duplicate DIC procedures.
	* exp_aggr.adb (Gen_Assign): Generate a call to the type's DIC
	procedure in the case where an array component is default
	initialized (due to an association with a box).
	(Build_Record_Aggr_Code): For an extension aggregate, generate a
	call to the ancestor type's DIC procedure (if any) when the
	ancestor part is a subtype mark. For a record component
	association that was specified with a box (tested for by
	checking the new flag Was_Default_Init_Box_Association),
	generate a call to the component type's DIC procedure (if it has
	one).
	* exp_ch4.adb (Expand_N_Allocator): When the allocated object is
	default initialized and the designated type has a DIC aspect,
	generate a call to the DIC procedure.
	* exp_util.ads (Build_DIC_Call): Change the formal Obj_Id to
	name Obj_Name, and change its type from Entity_Id to Node_Id
	(and update comment).
	(Build_DIC_Procedure_Body): Add formal Partial_DIC, remove
	formal For_Freeze, and update comment accordingly.
	(Build_DIC_Procedure_Declaration): Add formal Partial_DIC and
	update comment.
	* exp_util.adb
	(Build_DIC_Call): Revised to use its Obj_Name (formerly Obj_Id)
	formal directly rather than calling New_Occurrence_Of on it, to
	allow arbitrary names to be passed rather than being limited to
	Entity_Ids.
	(Build_DIC_Procedure_Body): Call Add_Parent_DICs to generate
	checks for DICs associated with any parent types, implementing
	the required "additive" semantics for DICs. When building a DIC
	procedure body for a partial view (when Partial_DIC is True),
	call Add_Own_DIC when the type has its own DIC.  In the case of
	"full" DIC procedures, a call is generated to any partial DIC
	procedure of the type (unless the procedure has a null body),
	along with checks for any DICs inherited by the full view.
	(Build_DIC_Procedure_Declaration): Add handling for partial DIC
	procedures.  For the suffix of a regular DIC procedure's name,
	use "DIC" (instead of "Default_Initial_Condition"), and for the
	suffix of a partial DIC procedure's name, use "Partial_DIC".
	(Add_DIC_Check): Add the DIC pragma to the list of seen pragmas
	(Pragmas_Seen).
	(Add_Inherited_Tagged_DIC): Remove the formals Par_Typ,
	Deriv_Typ, and Obj_Id, and add formal Expr, which denotes DIC's
	expression. Remove the call to Replace_References (which is now
	done in Add_Inherited_DICs).
	(Add_Inherited_DICs): New procedure to locate a DIC pragma
	associated with a parent type, replace its references
	appropriately (such as any current instance references), and add
	a check for the DIC.
	(Add_Own_DIC): Add an Obj_Id formal to allow caller to pass the
	_init formal of the generated DIC procedure.
	(Add_Parent_DICs): New procedure to traverse a type's parents,
	looking for DICs associated with those and calling
	Add_Inherited_DICs to apply the appropriate DIC checks.
	(Is_Verifiable_DIC_Pragma): Treat pragmas that have an Empty
	first argument the same as a pragma without any arguments
	(returning False for that case).
	* exp_ch3.adb (Init_One_Dimension): Generate calls to the
	component's DIC procedure when needed.
	(Possible_DIC_Call): New function nested in Init_One_Dimension
	to build a call to the array component type's DIC-checking
	function when appropriate.
	(Build_Array_Init_Proc): The presence of a DIC on the component
	type is an additional condition for generating an init proc for
	an array type.
	(Build_Init_Statements): When the record component's type has a
	DIC, and the component declaration does not have an
	initialization expression, generate a call to the component
	type's DIC procedure.
	(Expand_N_Object_Declaration): Modify the call to Build_DIC_Call
	to pass a new occurrence of the object's defining id rather than
	the id itself.
	(Freeze_Type): Only build a type's DIC procedure (if it has one)
	for types that are not interfaces.
	* exp_spark.adb (Expand_SPARK_N_Freeze_Type): Remove From_Freeze
	actual and add a ??? comment.
	(Expand_SPARK_N_Object_Declaration): Modify call to
	Build_DIC_Call to pass a new occurrence of the object id rather
	than the object id itself.
	* sem_aggr.adb (Resolve_Record_Aggregate): Declare local flag
	Is_Box_Init_By_Default and set it in cases where the component
	association has a box and the component is being initialized by
	default (as opposed to initialized by an initialization
	expression associated with the component's declaration).
	(Add_Association): If the association has a box for a component
	initialized by default, the flag
	Was_Default_Init_Box_Association is set on the new component
	association (for later testing during expansion).
	(Get_Value): Reset Is_Box_Init_By_Default to False.
	* sem_ch3.adb (Build_Assertion_Bodies_For_Type): Rearrange code
	to build DIC procedure bodies for a (noninterface) type that
	Has_Own_DIC (for partial type views) or Has_DIC (for full type
	views) as appropriate.
	* sem_ch13.adb (Analyze_Aspect_Specifications,
	Aspect_Default_Initial_Condition): Add an extra argument to the
	DIC pragma to denote the type associated with the pragma (for
	use in Build_DIC_Procedure_Body).
	* sem_prag.adb (Analyze_Pragma): Allow two arguments for pragma
	Default_Initial_Condition.  If not already present, add an extra
	argument denoting the type that the pragma is associated with.
	* sem_util.adb (Propagate_DIC_Attributes): Retrieve any partial
	DIC procedure associated with the type and add it to the type's
	list of subprograms (Subprograms_For_Type).
	* sinfo.ads (Was_Default_Init_Box_Association): New flag on
	N_Component_Association nodes.  Add subprograms to get and set
	flag, as well as updating the documentation.
	* sinfo.adb (Was_Default_Init_Box_Association): New function to
	retrieve the corresponding flag (Flag14).
	(Set_Was_Default_Init_Box_Association): New procedure to set the
	corresponding flag (Flag14).

1 files changed, 16 insertions, 0 deletions

diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index c88d9a9..2d0a957 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -3535,6 +3535,14 @@ package body Sinfo is
       return Flag2 (N);
    end Was_Attribute_Reference;
 
+   function Was_Default_Init_Box_Association
+     (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Component_Association);
+      return Flag14 (N);
+   end Was_Default_Init_Box_Association;
+
    function Was_Expression_Function
       (N : Node_Id) return Boolean is
    begin
@@ -7036,6 +7044,14 @@ package body Sinfo is
       Set_Flag2 (N, Val);
    end Set_Was_Attribute_Reference;
 
+   procedure Set_Was_Default_Init_Box_Association
+     (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Component_Association);
+      Set_Flag14 (N, Val);
+   end Set_Was_Default_Init_Box_Association;
+
    procedure Set_Was_Expression_Function
       (N : Node_Id; Val : Boolean := True) is
    begin