From: Hristian Kirtchev Date: Tue, 31 Jul 2018 09:55:16 +0000 (+0000) Subject: [Ada] Minor reformattings X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=617709748bf6e8c9590ce8a19a20c57de53a08e2;p=gcc.git [Ada] Minor reformattings 2018-07-31 Hristian Kirtchev gcc/ada * checks.adb, contracts.adb, exp_aggr.adb, exp_ch5.adb, exp_disp.adb, make.adb, sem_ch4.adb, sem_eval.adb, sem_res.adb, usage.adb: Minor reformatting. From-SVN: r263089 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d12064c25d5..00432f6b110 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2018-07-31 Hristian Kirtchev + + * checks.adb, contracts.adb, exp_aggr.adb, exp_ch5.adb, + exp_disp.adb, make.adb, sem_ch4.adb, sem_eval.adb, sem_res.adb, + usage.adb: Minor reformatting. + 2018-07-31 Bob Duff * sem_res.adb (Resolve_Allocator): Do not complain about the diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 0af436f0d70..871f1f73bdd 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -1873,40 +1873,36 @@ package body Checks is pragma Assert (Do_Division_Check (N)); Loc : constant Source_Ptr := Sloc (N); - Right : constant Node_Id := Right_Opnd (N); + Right : constant Node_Id := Right_Opnd (N); + Opnd : Node_Id; begin if Expander_Active and then not Backend_Divide_Checks_On_Target and then Check_Needed (Right, Division_Check) - then - -- See if division by zero possible, and if so generate test. This - -- part of the test is not controlled by the -gnato switch, since - -- it is a Division_Check and not an Overflow_Check. - if Do_Division_Check (N) then - Set_Do_Division_Check (N, False); + -- See if division by zero possible, and if so generate test. This + -- part of the test is not controlled by the -gnato switch, since it + -- is a Division_Check and not an Overflow_Check. - if (not ROK) or else (Rlo <= 0 and then 0 <= Rhi) then - if Is_Floating_Point_Type (Etype (N)) then - Insert_Action (N, - Make_Raise_Constraint_Error (Loc, - Condition => - Make_Op_Eq (Loc, - Left_Opnd => Duplicate_Subexpr_Move_Checks (Right), - Right_Opnd => Make_Real_Literal (Loc, Ureal_0)), - Reason => CE_Divide_By_Zero)); + and then Do_Division_Check (N) + then + Set_Do_Division_Check (N, False); - else - Insert_Action (N, - Make_Raise_Constraint_Error (Loc, - Condition => - Make_Op_Eq (Loc, - Left_Opnd => Duplicate_Subexpr_Move_Checks (Right), - Right_Opnd => Make_Integer_Literal (Loc, 0)), - Reason => CE_Divide_By_Zero)); - end if; + if (not ROK) or else (Rlo <= 0 and then 0 <= Rhi) then + if Is_Floating_Point_Type (Etype (N)) then + Opnd := Make_Real_Literal (Loc, Ureal_0); + else + Opnd := Make_Integer_Literal (Loc, 0); end if; + + Insert_Action (N, + Make_Raise_Constraint_Error (Loc, + Condition => + Make_Op_Eq (Loc, + Left_Opnd => Duplicate_Subexpr_Move_Checks (Right), + Right_Opnd => Opnd), + Reason => CE_Divide_By_Zero)); end if; end if; end Apply_Division_Check; @@ -3552,6 +3548,7 @@ package body Checks is and then not GNATprove_Mode then Apply_Float_Conversion_Check (Expr, Target_Type); + else Apply_Scalar_Range_Check (Expr, Target_Type, Fixed_Int => Conv_OK); diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index 69cece95361..5577604a6bf 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -888,8 +888,8 @@ package body Contracts is if not Is_Library_Level_Entity (Obj_Id) then Error_Msg_N - ("volatile variable & must be declared at library level", - Obj_Id); + ("volatile variable & must be declared at library level " + & "(SPARK RM 7.1.3(3))", Obj_Id); -- An object of a discriminated type cannot be effectively -- volatile except for protected objects (SPARK RM 7.1.3(5)). diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 27aa0d4af6c..65a06de303b 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -7242,21 +7242,19 @@ package body Exp_Aggr is -- constraint error. declare - Comp : Entity_Id; + Comp : constant Entity_Id := First (Choices (C)); Indx : Node_Id; begin - Comp := First (Choices (C)); if Present (Etype (Comp)) and then Is_Array_Type (Etype (Comp)) then Indx := First_Index (Etype (Comp)); - while Present (Indx) loop - if Nkind (Type_Low_Bound (Etype (Indx))) - = N_Raise_Constraint_Error - or else Nkind (Type_High_Bound (Etype (Indx))) - = N_Raise_Constraint_Error + if Nkind (Type_Low_Bound (Etype (Indx))) = + N_Raise_Constraint_Error + or else Nkind (Type_High_Bound (Etype (Indx))) = + N_Raise_Constraint_Error then return False; end if; @@ -7276,10 +7274,11 @@ package body Exp_Aggr is -- the machine.) if Is_Tagged_Type (Etype (Expr_Q)) - and then (Nkind (Expr_Q) = N_Type_Conversion - or else (Is_Entity_Name (Expr_Q) - and then - Ekind (Entity (Expr_Q)) in Formal_Kind)) + and then + (Nkind (Expr_Q) = N_Type_Conversion + or else + (Is_Entity_Name (Expr_Q) + and then Ekind (Entity (Expr_Q)) in Formal_Kind)) and then Tagged_Type_Expansion then Static_Components := False; diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 7371ee33acb..f2a26685dae 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1533,7 +1533,7 @@ package body Exp_Ch5 is A := Make_Assignment_Statement (Loc, - Name => + Name => Make_Selected_Component (Loc, Prefix => Duplicate_Subexpr (Lhs), Selector_Name => diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 2fa990bc11b..8270492fd7a 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -7202,18 +7202,19 @@ package body Exp_Disp is Make_Subtype_Indication (Loc, Subtype_Mark => New_Occurrence_Of (RTE (RE_Address_Array), Loc), - Constraint => + Constraint => Make_Index_Or_Discriminant_Constraint (Loc, New_List ( Make_Range (Loc, Low_Bound => Make_Integer_Literal (Loc, 1), - High_Bound => Make_Integer_Literal (Loc, - DT_Entry_Count - (First_Tag_Component (Typ))))))))); + High_Bound => + Make_Integer_Literal (Loc, + DT_Entry_Count + (First_Tag_Component (Typ))))))))); Append_To (Result, Make_Full_Type_Declaration (Loc, Defining_Identifier => DT_Prims_Acc, - Type_Definition => + Type_Definition => Make_Access_To_Object_Definition (Loc, Subtype_Indication => New_Occurrence_Of (DT_Prims, Loc)))); diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index cbc8dac10f9..50aaf5b48e5 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -1421,9 +1421,9 @@ package body Make is -------------------------- procedure Check_Linker_Options - (E_Stamp : Time_Stamp_Type; - O_File : out File_Name_Type; - O_Stamp : out Time_Stamp_Type) + (E_Stamp : Time_Stamp_Type; + O_File : out File_Name_Type; + O_Stamp : out Time_Stamp_Type) is procedure Check_File (File : File_Name_Type); -- Update O_File and O_Stamp if the given file is younger than E_Stamp @@ -1865,9 +1865,9 @@ package body Make is if Add_It then if not Queue.Insert - ((File => Sfile, - Unit => No_Unit_Name, - Index => 0)) + ((File => Sfile, + Unit => No_Unit_Name, + Index => 0)) then if Is_In_Obsoleted (Sfile) then Executable_Obsolete := True; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 597ec1ed939..89af5676348 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -8928,44 +8928,49 @@ package body Sem_Ch4 is (Anc_Type : Entity_Id; Error : out Boolean) is - Candidate : Entity_Id; - -- If homonym is a renaming, examine the renamed program - - Cls_Type : Entity_Id; - Hom : Entity_Id; - Hom_Ref : Node_Id; - Success : Boolean; - function First_Formal_Match - (Typ : Entity_Id) return Boolean; - -- Predicate to verify that the first formal of a class-wide - -- candidate matches the type of the prefix. + (Subp_Id : Entity_Id; + Typ : Entity_Id) return Boolean; + -- Predicate to verify that the first foramal of class-wide + -- subprogram Subp_Id matches type Typ of the prefix. ------------------------ -- First_Formal_Match -- ------------------------ function First_Formal_Match - (Typ : Entity_Id) return Boolean + (Subp_Id : Entity_Id; + Typ : Entity_Id) return Boolean is - Ctrl : constant Entity_Id := First_Formal (Candidate); + Ctrl : constant Entity_Id := First_Formal (Subp_Id); + begin - return Present (Ctrl) - and then - (Base_Type (Etype (Ctrl)) = Typ - or else - (Ekind (Etype (Ctrl)) = E_Anonymous_Access_Type - and then - Base_Type - (Designated_Type (Etype (Ctrl))) = Typ)); + return + Present (Ctrl) + and then + (Base_Type (Etype (Ctrl)) = Typ + or else + (Ekind (Etype (Ctrl)) = E_Anonymous_Access_Type + and then + Base_Type (Designated_Type (Etype (Ctrl))) = + Typ)); end First_Formal_Match; - begin - Error := False; + -- Local variables - Cls_Type := Class_Wide_Type (Anc_Type); + CW_Typ : constant Entity_Id := Class_Wide_Type (Anc_Type); - Hom := Current_Entity (Subprog); + Candidate : Entity_Id; + -- If homonym is a renaming, examine the renamed program + + Hom : Entity_Id; + Hom_Ref : Node_Id; + Success : Boolean; + + -- Start of processing for Traverse_Homonyms + + begin + Error := False; -- Find a non-hidden operation whose first parameter is of the -- class-wide type, a subtype thereof, or an anonymous access @@ -8973,6 +8978,7 @@ package body Sem_Ch4 is -- even if hidden (it may be hidden because the instantiation -- is expanded after the containing package has been analyzed). + Hom := Current_Entity (Subprog); while Present (Hom) loop if Ekind_In (Hom, E_Procedure, E_Function) and then Present (Renamed_Entity (Hom)) @@ -8983,10 +8989,10 @@ package body Sem_Ch4 is Candidate := Hom; end if; - if Ekind_In (Candidate, E_Procedure, E_Function) + if Ekind_In (Candidate, E_Function, E_Procedure) and then (not Is_Hidden (Candidate) or else In_Instance) and then Scope (Candidate) = Scope (Base_Type (Anc_Type)) - and then First_Formal_Match (Cls_Type) + and then First_Formal_Match (Candidate, CW_Typ) then -- If the context is a procedure call, ignore functions -- in the name of the call. @@ -9006,16 +9012,16 @@ package body Sem_Ch4 is goto Next_Hom; end if; - Set_Etype (Call_Node, Any_Type); + Set_Etype (Call_Node, Any_Type); Set_Is_Overloaded (Call_Node, False); Success := False; if No (Matching_Op) then Hom_Ref := New_Occurrence_Of (Candidate, Sloc (Subprog)); - Set_Etype (Call_Node, Any_Type); - Set_Parent (Call_Node, Parent (Node_To_Replace)); - Set_Name (Call_Node, Hom_Ref); + Set_Etype (Call_Node, Any_Type); + Set_Name (Call_Node, Hom_Ref); + Set_Parent (Call_Node, Parent (Node_To_Replace)); Analyze_One_Call (N => Call_Node, @@ -9040,7 +9046,7 @@ package body Sem_Ch4 is -- Check for this case before reporting a real ambiguity. if Present - (Valid_Candidate (Success, Call_Node, Candidate)) + (Valid_Candidate (Success, Call_Node, Candidate)) and then Nkind (Call_Node) /= N_Function_Call and then Candidate /= Matching_Op then diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 51094cd1730..c14347b0e7d 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -5688,8 +5688,8 @@ package body Sem_Eval is ------------------------- procedure Rewrite_In_Raise_CE (N : Node_Id; Exp : Node_Id) is - Typ : constant Entity_Id := Etype (N); Stat : constant Boolean := Is_Static_Expression (N); + Typ : constant Entity_Id := Etype (N); begin -- If we want to raise CE in the condition of a N_Raise_CE node, we diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 659b1efc6dd..674aec4fc6b 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -5015,9 +5015,10 @@ package body Sem_Res is if In_Instance_Body then Error_Msg_Warn := SPARK_Mode /= On; Error_Msg_N - ("type in allocator has deeper level than " - & "designated class-wide type<<", E); + ("type in allocator has deeper level than designated " + & "class-wide type<<", E); Error_Msg_N ("\Program_Error [<<", E); + Rewrite (N, Make_Raise_Program_Error (Sloc (N), Reason => PE_Accessibility_Check_Failed)); @@ -5028,8 +5029,9 @@ package body Sem_Res is -- type. A run-time check will be performed in the instance. elsif not Is_Generic_Type (Exp_Typ) then - Error_Msg_N ("type in allocator has deeper level than " - & "designated class-wide type", E); + Error_Msg_N + ("type in allocator has deeper level than designated " + & "class-wide type", E); end if; end if; end; diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index cdf14cf8db8..754e8d89f8b 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -461,6 +461,7 @@ begin Write_Line (" I turn off checking for in params"); Write_Line (" m turn on checking for in out params"); Write_Line (" M turn off checking for in out params"); + Write_Line (" n turn off all validity checks (including RM)"); Write_Line (" o turn on checking for operators/attributes"); Write_Line (" O turn off checking for operators/attributes"); Write_Line (" p turn on checking for parameters"); @@ -471,7 +472,6 @@ begin Write_Line (" S turn off checking for subscripts"); Write_Line (" t turn on checking for tests"); Write_Line (" T turn off checking for tests"); - Write_Line (" n turn off all validity checks (including RM)"); -- Lines for -gnatw switch