From f7937111e8c8cfaf5ea79d97c65d6b6dc29b261f Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Mon, 2 Nov 2020 01:21:09 -0500 Subject: [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). --- gcc/ada/sem_prag.adb | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) (limited to 'gcc/ada/sem_prag.adb') diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 02369bc..1bcbb25 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -15111,7 +15111,7 @@ package body Sem_Prag is begin GNAT_Pragma; Check_No_Identifiers; - Check_At_Most_N_Arguments (1); + Check_At_Most_N_Arguments (2); -- Accounts for implicit type arg Typ := Empty; Stmt := Prev (N); @@ -15174,6 +15174,27 @@ package body Sem_Prag is Set_Has_Own_DIC (Typ); + -- A type entity argument is appended to facilitate inheriting the + -- aspect/pragma from parent types (see Build_DIC_Procedure_Body), + -- though that extra argument isn't documented for the pragma. + + if not Present (Arg2) then + -- When the pragma has no arguments, create an argument with + -- the value Empty, so the type name argument can be appended + -- following it (since it's expected as the second argument). + + if not Present (Arg1) then + Set_Pragma_Argument_Associations (N, New_List ( + Make_Pragma_Argument_Association (Sloc (Typ), + Expression => Empty))); + end if; + + Append_To + (Pragma_Argument_Associations (N), + Make_Pragma_Argument_Association (Sloc (Typ), + Expression => New_Occurrence_Of (Typ, Sloc (Typ)))); + end if; + -- Chain the pragma on the rep item chain for further processing Discard := Rep_Item_Too_Late (Typ, N, FOnly => True); -- cgit v1.1