[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, 17 insertions, 1 deletions

diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 439eef4..f9b0667 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -2412,6 +2412,11 @@ package Sinfo is
    --    instantiation prologue renames these attributes, and expansion later
    --    converts them into subprogram bodies.
 
+   --  Was_Default_Init_Box_Association (Flag14-Sem)
+   --    Present in N_Component_Association. Set to True if the original source
+   --    is an aggregate component association with a box (<>) for a component
+   --    that is initialized by default.
+
    --  Was_Expression_Function (Flag18-Sem)
    --    Present in N_Subprogram_Body. True if the original source had an
    --    N_Expression_Function, which was converted to the N_Subprogram_Body
@@ -4120,6 +4125,7 @@ package Sinfo is
       --  Expression (Node3) (empty if Box_Present)
       --  Loop_Actions (List5-Sem)
       --  Box_Present (Flag15)
+      --  Was_Default_Init_Box_Association (Flag14)
       --  Inherited_Discriminant (Flag13)
 
       --  Note: this structure is used for both record component associations
@@ -4128,7 +4134,9 @@ package Sinfo is
       --  list of selector names in the record aggregate case, or a list of
       --  discrete choices in the array aggregate case or an N_Others_Choice
       --  node (which appears as a singleton list). Box_Present gives support
-      --  to Ada 2005 (AI-287).
+      --  to Ada 2005 (AI-287). Was_Default_Init_Box_Association is used for
+      --  determining the need for Default_Initial_Condition check on component
+      --  associations with a box.
 
       ----------------------------------
       -- 4.3.1  Component Choice List --
@@ -10254,6 +10262,9 @@ package Sinfo is
    function Was_Attribute_Reference
      (N : Node_Id) return Boolean;    -- Flag2
 
+   function Was_Default_Init_Box_Association
+     (N : Node_Id) return Boolean;    -- Flag14
+
    function Was_Expression_Function
      (N : Node_Id) return Boolean;    -- Flag18
 
@@ -11366,6 +11377,9 @@ package Sinfo is
    procedure Set_Was_Attribute_Reference
      (N : Node_Id; Val : Boolean := True);    -- Flag2
 
+   procedure Set_Was_Default_Init_Box_Association
+     (N : Node_Id; Val : Boolean := True);    -- Flag14
+
    procedure Set_Was_Expression_Function
      (N : Node_Id; Val : Boolean := True);    -- Flag18
 
@@ -13477,6 +13491,7 @@ package Sinfo is
    pragma Inline (Visible_Declarations);
    pragma Inline (Used_Operations);
    pragma Inline (Was_Attribute_Reference);
+   pragma Inline (Was_Default_Init_Box_Association);
    pragma Inline (Was_Expression_Function);
    pragma Inline (Was_Originally_Stub);
 
@@ -13842,6 +13857,7 @@ package Sinfo is
    pragma Inline (Set_Variants);
    pragma Inline (Set_Visible_Declarations);
    pragma Inline (Set_Was_Attribute_Reference);
+   pragma Inline (Set_Was_Default_Init_Box_Association);
    pragma Inline (Set_Was_Expression_Function);
    pragma Inline (Set_Was_Originally_Stub);