diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 12 | ||||
| -rw-r--r-- | gcc/ada/checks.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/exp_attr.adb | 90 | ||||
| -rw-r--r-- | gcc/ada/exp_util.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 44 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 21 |
6 files changed, 104 insertions, 79 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5ef8c6d..59ee6e5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2017-05-02 Hristian Kirtchev <kirtchev@adacore.com> + + * checks.adb, sem_ch3.adb, sem_ch6.adb: Minor reformatting. + +2017-05-02 Bob Duff <duff@adacore.com> + + * exp_attr.adb (Callable, Identity, Terminated): Use Find_Prim_Op + to find primitive ops, instead of using an Identifier that will + later be looked up. This is necessary because these ops are not + necessarily visible at all places where we need to call them. + * exp_util.ads: Minor comment fix. + 2017-05-02 Ed Schonberg <schonberg@adacore.com> * sem_ch6.adb (Fully_Conformant_Expressions): Two entity diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index a5a57c4..40f4e65 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -4124,7 +4124,7 @@ package body Checks is if Present (Comp) then - -- Specialize the error message to indicate that we are dealing + -- Specialize the warning message to indicate that we are dealing -- with an uninitialized composite object that has a defaulted -- null-excluding component. @@ -4133,9 +4133,11 @@ package body Checks is Apply_Compile_Time_Constraint_Error (N => Expression (N), - Msg => "(Ada 2005) null-excluding component % of object % " & - "must be initialized??", + Msg => + "(Ada 2005) null-excluding component % of object % must be " + & "initialized??", Reason => CE_Null_Not_Allowed); + else Apply_Compile_Time_Constraint_Error (N => Expression (N), diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index b81e26c..4d8417a 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -1028,7 +1028,7 @@ package body Exp_Attr is Loc : Source_Ptr; Loop_Id : Entity_Id; Loop_Stmt : Node_Id; - Result : Node_Id; + Result : Node_Id := Empty; Scheme : Node_Id; Temp_Decl : Node_Id; Temp_Id : Entity_Id; @@ -1093,8 +1093,6 @@ package body Exp_Attr is Decls := Declarations (Parent (Parent (Loop_Stmt))); end if; - Result := Empty; - -- Transform the loop into a conditional block else @@ -2480,20 +2478,25 @@ package body Exp_Attr is and then Is_Interface (Ptyp) and then Is_Task_Interface (Ptyp) then - Rewrite (N, - Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_Callable), Loc), - Parameter_Associations => New_List ( - Make_Unchecked_Type_Conversion (Loc, - Subtype_Mark => - New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc), - Expression => - Make_Selected_Component (Loc, - Prefix => - New_Copy_Tree (Pref), - Selector_Name => - Make_Identifier (Loc, Name_uDisp_Get_Task_Id)))))); + declare + Id : constant Node_Id := + New_Occurrence_Of + (Find_Prim_Op (Ptyp, Name_uDisp_Get_Task_Id), Loc); + Call : constant Node_Id := + Make_Function_Call (Loc, + Name => Id, + Parameter_Associations => New_List (Pref)); + begin + Rewrite (N, + Make_Function_Call (Loc, + Name => + New_Occurrence_Of (RTE (RE_Callable), Loc), + Parameter_Associations => New_List ( + Make_Unchecked_Type_Conversion (Loc, + Subtype_Mark => + New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc), + Expression => Call)))); + end; else Rewrite (N, @@ -3578,13 +3581,17 @@ package body Exp_Attr is and then Is_Interface (Ptyp) and then Is_Task_Interface (Ptyp) then - Rewrite (N, - Unchecked_Convert_To (Id_Kind, - Make_Selected_Component (Loc, - Prefix => - New_Copy_Tree (Pref), - Selector_Name => - Make_Identifier (Loc, Name_uDisp_Get_Task_Id)))); + declare + Id : constant Node_Id := + New_Occurrence_Of + (Find_Prim_Op (Ptyp, Name_uDisp_Get_Task_Id), Loc); + Call : constant Node_Id := + Make_Function_Call (Loc, + Name => Id, + Parameter_Associations => New_List (Pref)); + begin + Rewrite (N, Unchecked_Convert_To (Id_Kind, Call)); + end; else Rewrite (N, @@ -6264,27 +6271,32 @@ package body Exp_Attr is -- The prefix of Terminated is of a task interface class-wide type. -- Generate: - -- terminated (Task_Id (Pref._disp_get_task_id)); + -- terminated (Task_Id (_disp_get_task_id (Pref))); if Ada_Version >= Ada_2005 and then Ekind (Ptyp) = E_Class_Wide_Type and then Is_Interface (Ptyp) and then Is_Task_Interface (Ptyp) then - Rewrite (N, - Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_Terminated), Loc), - Parameter_Associations => New_List ( - Make_Unchecked_Type_Conversion (Loc, - Subtype_Mark => - New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc), - Expression => - Make_Selected_Component (Loc, - Prefix => - New_Copy_Tree (Pref), - Selector_Name => - Make_Identifier (Loc, Name_uDisp_Get_Task_Id)))))); + declare + Id : constant Node_Id := + New_Occurrence_Of + (Find_Prim_Op (Ptyp, Name_uDisp_Get_Task_Id), Loc); + Call : constant Node_Id := + Make_Function_Call (Loc, + Name => Id, + Parameter_Associations => New_List (Pref)); + begin + Rewrite (N, + Make_Function_Call (Loc, + Name => + New_Occurrence_Of (RTE (RE_Terminated), Loc), + Parameter_Associations => New_List ( + Make_Unchecked_Type_Conversion (Loc, + Subtype_Mark => + New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc), + Expression => Call)))); + end; elsif Restricted_Profile then Rewrite (N, diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 3f60993..485374b 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -592,11 +592,9 @@ package Exp_Util is function Find_Prim_Op (T : Entity_Id; Name : TSS_Name_Type) return Entity_Id; - -- Find the first primitive operation of type T whose name has the form - -- indicated by the name parameter (i.e. is a type support subprogram - -- with the indicated suffix). This function allows use of a primitive - -- operation which is not directly visible. If T is a class wide type, - -- then the reference is to an operation of the corresponding root type. + -- Same as Find_Prim_Op above, except we're searching for an op that has + -- the form indicated by Name (i.e. is a type support subprogram with the + -- indicated suffix). function Find_Optional_Prim_Op (T : Entity_Id; Name : Name_Id) return Entity_Id; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 24560159..9ad370f 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3583,17 +3583,17 @@ package body Sem_Ch3 is T : Entity_Id; E : Node_Id := Expression (N); - -- E is set to Expression (N) throughout this routine. When - -- Expression (N) is modified, E is changed accordingly. + -- E is set to Expression (N) throughout this routine. When Expression + -- (N) is modified, E is changed accordingly. Prev_Entity : Entity_Id := Empty; procedure Check_For_Null_Excluding_Components (Obj_Typ : Entity_Id; Obj_Decl : Node_Id); - -- Recursively verify that each null-excluding component of an object - -- declaration's type has explicit initialization, and generate - -- compile-time warnings for each one that does not. + -- Verify that each null-excluding component of object declaration + -- Obj_Decl carrying type Obj_Typ has explicit initialization. Emit + -- a compile-time warning if this is not the case. function Count_Tasks (T : Entity_Id) return Uint; -- This function is called when a non-generic library level object of a @@ -3622,12 +3622,12 @@ package body Sem_Ch3 is (Obj_Typ : Entity_Id; Obj_Decl : Node_Id) is - procedure Check_Component (Comp_Typ : Entity_Id; Comp_Decl : Node_Id := Empty); - -- Perform compile-time null-exclusion checks on a given component - -- and all of its subcomponents, if any. + -- Apply a compile-time null-exclusion check on a component denoted + -- by its declaration Comp_Decl and type Comp_Typ, and all of its + -- subcomponents (if any). --------------------- -- Check_Component -- @@ -3641,15 +3641,14 @@ package body Sem_Ch3 is T : Entity_Id; begin - -- Return without further checking if the component has explicit - -- initialization or does not come from source. + -- Do not consider internally-generated components or those that + -- are already initialized. - if Present (Comp_Decl) then - if not Comes_From_Source (Comp_Decl) - or else Present (Expression (Comp_Decl)) - then - return; - end if; + if Present (Comp_Decl) + and then (not Comes_From_Source (Comp_Decl) + or else Present (Expression (Comp_Decl))) + then + return; end if; if Is_Incomplete_Or_Private_Type (Comp_Typ) @@ -3667,9 +3666,10 @@ package body Sem_Ch3 is then Null_Exclusion_Static_Checks (Obj_Decl, Comp_Decl); - -- Check array type components + -- Check array components elsif Is_Array_Type (T) then + -- There is no suitable component when the object is of an -- array type. However, a namable component may appear at some -- point during the recursive inspection, but not at the top @@ -3681,12 +3681,10 @@ package body Sem_Ch3 is Check_Component (Component_Type (T), Comp_Decl); end if; - -- If T allows named components, then iterate through them, - -- recursively verifying all subcomponents. + -- Verify all components of type T - -- NOTE: Due to the complexities involved with checking components - -- of nontrivial types with discriminants (variant records and - -- the like), no static checking is performed on them. ??? + -- Note: No checks are performed on types with discriminants due + -- to complexities involving variants. ??? elsif (Is_Concurrent_Type (T) or else Is_Incomplete_Or_Private_Type (T) @@ -3910,12 +3908,12 @@ package body Sem_Ch3 is -- out some static checks. if Ada_Version >= Ada_2005 then + -- In case of aggregates we must also take care of the correct -- initialization of nested aggregates bug this is done at the -- point of the analysis of the aggregate (see sem_aggr.adb) ??? if Can_Never_Be_Null (T) then - if Present (Expression (N)) and then Nkind (Expression (N)) = N_Aggregate then diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 98c893b..5c31c42 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -8763,18 +8763,20 @@ package body Sem_Ch6 is if Present (Entity (E1)) then return Entity (E1) = Entity (E2) - -- One may be a discriminant that has been replaced by - -- the corresponding discriminal. + -- One may be a discriminant that has been replaced by the + -- corresponding discriminal. - or else (Chars (Entity (E1)) = Chars (Entity (E2)) - and then Ekind (Entity (E1)) = E_Discriminant - and then Ekind (Entity (E2)) = E_In_Parameter) + or else + (Chars (Entity (E1)) = Chars (Entity (E2)) + and then Ekind (Entity (E1)) = E_Discriminant + and then Ekind (Entity (E2)) = E_In_Parameter) -- The discriminant of a protected type is transformed into -- a local constant and then into a parameter of a protected -- operation. - or else (Ekind (Entity (E1)) = E_Constant + or else + (Ekind (Entity (E1)) = E_Constant and then Ekind (Entity (E2)) = E_In_Parameter and then Present (Discriminal_Link (Entity (E1))) and then Discriminal_Link (Entity (E1)) = @@ -8784,9 +8786,10 @@ package body Sem_Ch6 is -- match if they have the same identifier, even though they -- are different entities. - or else (Chars (Entity (E1)) = Chars (Entity (E2)) - and then Ekind (Entity (E1)) = E_Loop_Parameter - and then Ekind (Entity (E2)) = E_Loop_Parameter); + or else + (Chars (Entity (E1)) = Chars (Entity (E2)) + and then Ekind (Entity (E1)) = E_Loop_Parameter + and then Ekind (Entity (E2)) = E_Loop_Parameter); elsif Nkind (E1) = N_Expanded_Name and then Nkind (E2) = N_Expanded_Name |