From 35338c60e4634e29d8704df6e7012fcdc7eb909c Mon Sep 17 00:00:00 2001 From: Etienne Servais Date: Wed, 29 Sep 2021 15:22:00 +0200 Subject: [Ada] Remove constant arguments gcc/ada/ * ali.adb (Get_Name): Ignore_Spaces is always False. * bindo-graphs.adb (Set_Is_Existing_Source_Target_Relation): Val is always True. * cstand.adb (New_Standard_Entity): New_Node_Kind is always N_Defininig_Identifier. * exp_ch3.adb (Predef_Stream_Attr_Spec): For_Body is always False. * exp_dist.adb (Add_Parameter_To_NVList): RACW_Ctrl is always False. * gnatls.adb (Add_Directories): Prepend is always False. * sem_ch10.adb, sem_ch10.ads (Load_Needed_Body): Do_Analyze is always True. * sem_ch3.adb, sem_ch3.ads (Process_Range_Expr_In_Decl): R_Check_Off is always False. * sem_elab.adb: (Info_Variable_Reference): Info_Msg is always False, In_SPARK is always True. (Set_Is_Traversed_Body, Set_Is_Saved_Construct, Set_Is_Saved_Relation): Val is always True. * treepr.adb (Visit_Descendant): No_Indent is always False. (Print_Node): Fmt does not need such a big scope. --- gcc/ada/ali.adb | 17 ++--- gcc/ada/bindo-graphs.adb | 14 +--- gcc/ada/cstand.adb | 8 +- gcc/ada/exp_ch3.adb | 16 ++-- gcc/ada/exp_dist.adb | 6 +- gcc/ada/gnatls.adb | 16 ++-- gcc/ada/sem_ch10.adb | 10 +-- gcc/ada/sem_ch10.ads | 9 +-- gcc/ada/sem_ch3.adb | 189 ++++++++++++++++++++++------------------------- gcc/ada/sem_ch3.ads | 12 ++- gcc/ada/sem_elab.adb | 77 ++++++------------- gcc/ada/treepr.adb | 34 +++------ 12 files changed, 160 insertions(+), 248 deletions(-) diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 3815a70..88cc247 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -963,19 +963,18 @@ package body ALI is -- special characters are included in the returned name. function Get_Name - (Ignore_Spaces : Boolean := False; - Ignore_Special : Boolean := False; + (Ignore_Special : Boolean := False; May_Be_Quoted : Boolean := False) return Name_Id; -- Skip blanks, then scan out a name (name is left in Name_Buffer with -- length in Name_Len, as well as being returned in Name_Id form). -- If Lower is set to True then the Name_Buffer will be converted to -- all lower case, for systems where file names are not case sensitive. -- This ensures that gnatbind works correctly regardless of the case - -- of the file name on all systems. The termination condition depends - -- on the settings of Ignore_Spaces and Ignore_Special: + -- of the file name on all systems. -- - -- If Ignore_Spaces is False (normal case), then scan is terminated - -- by the normal end of field condition (EOL, space, horizontal tab) + -- The scan is terminated by the normal end of field condition + -- (EOL, space, horizontal tab). Furthermore, the termination condition + -- depends on the setting of Ignore_Special: -- -- If Ignore_Special is False (normal case), the scan is terminated by -- a typeref bracket or an equal sign except for the special case of @@ -986,7 +985,6 @@ package body ALI is -- the name is 'unquoted'. In this case Ignore_Special is ignored and -- assumed to be True. -- - -- It is an error to set both Ignore_Spaces and Ignore_Special to True. -- This function handles wide characters properly. function Get_Nat return Nat; @@ -1240,8 +1238,7 @@ package body ALI is -------------- function Get_Name - (Ignore_Spaces : Boolean := False; - Ignore_Special : Boolean := False; + (Ignore_Special : Boolean := False; May_Be_Quoted : Boolean := False) return Name_Id is Char : Character; @@ -1298,7 +1295,7 @@ package body ALI is loop Add_Char_To_Name_Buffer (Getc); - exit when At_End_Of_Field and then not Ignore_Spaces; + exit when At_End_Of_Field; if not Ignore_Special then if Name_Buffer (1) = '"' then diff --git a/gcc/ada/bindo-graphs.adb b/gcc/ada/bindo-graphs.adb index 011b0f4..0989981 100644 --- a/gcc/ada/bindo-graphs.adb +++ b/gcc/ada/bindo-graphs.adb @@ -4903,11 +4903,10 @@ package body Bindo.Graphs is procedure Set_Is_Existing_Source_Target_Relation (G : Invocation_Graph; - Rel : Source_Target_Relation; - Val : Boolean := True); + Rel : Source_Target_Relation); pragma Inline (Set_Is_Existing_Source_Target_Relation); -- Mark a source vertex and a target vertex described by relation Rel as - -- already related in invocation graph G depending on value Val. + -- already related in invocation graph G. procedure Set_IGE_Attributes (G : Invocation_Graph; @@ -5636,19 +5635,14 @@ package body Bindo.Graphs is procedure Set_Is_Existing_Source_Target_Relation (G : Invocation_Graph; - Rel : Source_Target_Relation; - Val : Boolean := True) + Rel : Source_Target_Relation) is begin pragma Assert (Present (G)); pragma Assert (Present (Rel.Source)); pragma Assert (Present (Rel.Target)); - if Val then - Relation_Sets.Insert (G.Relations, Rel); - else - Relation_Sets.Delete (G.Relations, Rel); - end if; + Relation_Sets.Insert (G.Relations, Rel); end Set_Is_Existing_Source_Target_Relation; ------------------------ diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 409944c..41de2a5 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -149,8 +149,7 @@ package body CStand is function New_Operator (Op : Name_Id; Typ : Entity_Id) return Entity_Id; -- Build entity for standard operator with given name and type - function New_Standard_Entity - (New_Node_Kind : Node_Kind := N_Defining_Identifier) return Entity_Id; + function New_Standard_Entity return Entity_Id; -- Builds a new entity for Standard function New_Standard_Entity (Nam : String) return Entity_Id; @@ -1793,10 +1792,9 @@ package body CStand is -- New_Standard_Entity -- ------------------------- - function New_Standard_Entity - (New_Node_Kind : Node_Kind := N_Defining_Identifier) return Entity_Id + function New_Standard_Entity return Entity_Id is - E : constant Entity_Id := New_Entity (New_Node_Kind, Stloc); + E : constant Entity_Id := New_Entity (N_Defining_Identifier, Stloc); begin -- All standard entities are Pure and Public diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 702c7da..1f4f191 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -332,10 +332,9 @@ package body Exp_Ch3 is -- no declarations and no statements. function Predef_Stream_Attr_Spec - (Loc : Source_Ptr; - Tag_Typ : Entity_Id; - Name : TSS_Name_Type; - For_Body : Boolean := False) return Node_Id; + (Loc : Source_Ptr; + Tag_Typ : Entity_Id; + Name : TSS_Name_Type) return Node_Id; -- Specialized version of Predef_Spec_Or_Body that apply to read, write, -- input and output attribute whose specs are constructed in Exp_Strm. @@ -10907,10 +10906,9 @@ package body Exp_Ch3 is ----------------------------- function Predef_Stream_Attr_Spec - (Loc : Source_Ptr; - Tag_Typ : Entity_Id; - Name : TSS_Name_Type; - For_Body : Boolean := False) return Node_Id + (Loc : Source_Ptr; + Tag_Typ : Entity_Id; + Name : TSS_Name_Type) return Node_Id is Ret_Type : Entity_Id; @@ -10928,7 +10926,7 @@ package body Exp_Ch3 is Tag_Typ => Tag_Typ, Profile => Build_Stream_Attr_Profile (Loc, Tag_Typ, Name), Ret_Type => Ret_Type, - For_Body => For_Body); + For_Body => False); end Predef_Stream_Attr_Spec; --------------------------------- diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 5cb8fb5..41c0aea 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -300,12 +300,9 @@ package body Exp_Dist is NVList : Entity_Id; Parameter : Entity_Id; Constrained : Boolean; - RACW_Ctrl : Boolean := False; Any : Entity_Id) return Node_Id; -- Return a call to Add_Item to add the Any corresponding to the designated -- formal Parameter (with the indicated Constrained status) to NVList. - -- RACW_Ctrl must be set to True for controlling formals of distributed - -- object primitive operations. -------------------- -- Stub_Structure -- @@ -1089,7 +1086,6 @@ package body Exp_Dist is NVList : Entity_Id; Parameter : Entity_Id; Constrained : Boolean; - RACW_Ctrl : Boolean := False; Any : Entity_Id) return Node_Id is Parameter_Name_String : String_Id; @@ -1146,7 +1142,7 @@ package body Exp_Dist is Parameter_Name_String := String_From_Name_Buffer; - if RACW_Ctrl or else Nkind (Parameter) = N_Defining_Identifier then + if Nkind (Parameter) = N_Defining_Identifier then -- When the parameter passed to Add_Parameter_To_NVList is an -- Extra_Constrained parameter, Parameter is an N_Defining_ diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index c676996..68990e1 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -234,9 +234,8 @@ procedure Gnatls is -- already been initialized. procedure Add_Directories - (Self : in out String_Access; - Path : String; - Prepend : Boolean := False); + (Self : in out String_Access; + Path : String); -- Add one or more directories to the path. Directories added with this -- procedure are added in order after the current directory and before -- the path given by the environment variable GPR_PROJECT_PATH. A value @@ -1239,9 +1238,8 @@ procedure Gnatls is --------------------- procedure Add_Directories - (Self : in out String_Access; - Path : String; - Prepend : Boolean := False) + (Self : in out String_Access; + Path : String) is Tmp : String_Access; @@ -1250,11 +1248,7 @@ procedure Gnatls is Self := new String'(Uninitialized_Prefix & Path); else Tmp := Self; - if Prepend then - Self := new String'(Path & Path_Separator & Tmp.all); - else - Self := new String'(Tmp.all & Path_Separator & Path); - end if; + Self := new String'(Tmp.all & Path_Separator & Path); Free (Tmp); end if; end Add_Directories; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index dd78501..75a0379 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -5610,9 +5610,8 @@ package body Sem_Ch10 is -- demand, at the point of instantiation (see ch12). procedure Load_Needed_Body - (N : Node_Id; - OK : out Boolean; - Do_Analyze : Boolean := True) + (N : Node_Id; + OK : out Boolean) is Body_Name : Unit_Name_Type; Unum : Unit_Number_Type; @@ -5646,9 +5645,8 @@ package body Sem_Ch10 is Write_Eol; end if; - if Do_Analyze then - Semantics (Cunit (Unum)); - end if; + -- We always perform analyses + Semantics (Cunit (Unum)); end if; OK := True; diff --git a/gcc/ada/sem_ch10.ads b/gcc/ada/sem_ch10.ads index fbaf3ca..ecf3151a5 100644 --- a/gcc/ada/sem_ch10.ads +++ b/gcc/ada/sem_ch10.ads @@ -59,16 +59,13 @@ package Sem_Ch10 is -- reported on Error_Node (if present); otherwise no error is reported. procedure Load_Needed_Body - (N : Node_Id; - OK : out Boolean; - Do_Analyze : Boolean := True); + (N : Node_Id; + OK : out Boolean); -- Load and analyze the body of a context unit that is generic, or that -- contains generic units or inlined units. The body becomes part of the -- semantic dependency set of the unit that needs it. The returned result -- in OK is True if the load is successful, and False if the requested file - -- cannot be found. If the flag Do_Analyze is false, the unit is loaded and - -- parsed only. This allows a selective analysis in some inlining cases - -- where a full analysis would lead so circularities in the back-end. + -- cannot be found. procedure Remove_Context (N : Node_Id); -- Removes the entities from the context clause of the given compilation diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index f1a56ad..57db637 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -21641,11 +21641,10 @@ package body Sem_Ch3 is -------------------------------- procedure Process_Range_Expr_In_Decl - (R : Node_Id; - T : Entity_Id; - Subtyp : Entity_Id := Empty; - Check_List : List_Id := No_List; - R_Check_Off : Boolean := False) + (R : Node_Id; + T : Entity_Id; + Subtyp : Entity_Id := Empty; + Check_List : List_Id := No_List) is Lo, Hi : Node_Id; R_Checks : Check_Result; @@ -21748,13 +21747,8 @@ package body Sem_Ch3 is -- represent the null range the Constraint_Error exception should -- not be raised. - -- ??? The following code should be cleaned up as follows - - -- 1. The Is_Null_Range (Lo, Hi) test should disappear since it - -- is done in the call to Range_Check (R, T); below - - -- 2. The use of R_Check_Off should be investigated and possibly - -- removed, this would clean up things a bit. + -- ??? The Is_Null_Range (Lo, Hi) test should disappear since it + -- is done in the call to Range_Check (R, T); below. if Is_Null_Range (Lo, Hi) then null; @@ -21771,8 +21765,8 @@ package body Sem_Ch3 is if Expander_Active or GNATprove_Mode then - -- Call Force_Evaluation to create declarations as needed to - -- deal with side effects, and also create typ_FIRST/LAST + -- Call Force_Evaluation to create declarations as needed + -- to deal with side effects, and also create typ_FIRST/LAST -- entities for bounds if we have a subtype name. -- Note: we do this transformation even if expansion is not @@ -21790,106 +21784,103 @@ package body Sem_Ch3 is -- because the type we check against isn't necessarily the place -- where we put the check. - if not R_Check_Off then - R_Checks := Get_Range_Checks (R, T); - - -- Look up tree to find an appropriate insertion point. We - -- can't just use insert_actions because later processing - -- depends on the insertion node. Prior to Ada 2012 the - -- insertion point could only be a declaration or a loop, but - -- quantified expressions can appear within any context in an - -- expression, and the insertion point can be any statement, - -- pragma, or declaration. - - Insert_Node := Parent (R); - while Present (Insert_Node) loop - exit when - Nkind (Insert_Node) in N_Declaration - and then - Nkind (Insert_Node) not in N_Component_Declaration - | N_Loop_Parameter_Specification - | N_Function_Specification - | N_Procedure_Specification; - - exit when Nkind (Insert_Node) in - N_Later_Decl_Item | - N_Statement_Other_Than_Procedure_Call | - N_Procedure_Call_Statement | - N_Pragma; - - Insert_Node := Parent (Insert_Node); - end loop; + R_Checks := Get_Range_Checks (R, T); - -- Why would Type_Decl not be present??? Without this test, - -- short regression tests fail. + -- Look up tree to find an appropriate insertion point. We can't + -- just use insert_actions because later processing depends on + -- the insertion node. Prior to Ada 2012 the insertion point could + -- only be a declaration or a loop, but quantified expressions can + -- appear within any context in an expression, and the insertion + -- point can be any statement, pragma, or declaration. - if Present (Insert_Node) then + Insert_Node := Parent (R); + while Present (Insert_Node) loop + exit when + Nkind (Insert_Node) in N_Declaration + and then + Nkind (Insert_Node) not in N_Component_Declaration + | N_Loop_Parameter_Specification + | N_Function_Specification + | N_Procedure_Specification; + + exit when Nkind (Insert_Node) in + N_Later_Decl_Item | + N_Statement_Other_Than_Procedure_Call | + N_Procedure_Call_Statement | + N_Pragma; + + Insert_Node := Parent (Insert_Node); + end loop; - -- Case of loop statement. Verify that the range is part - -- of the subtype indication of the iteration scheme. + -- Why would Type_Decl not be present??? Without this test, + -- short regression tests fail. - if Nkind (Insert_Node) = N_Loop_Statement then - declare - Indic : Node_Id; + if Present (Insert_Node) then - begin - Indic := Parent (R); - while Present (Indic) - and then Nkind (Indic) /= N_Subtype_Indication - loop - Indic := Parent (Indic); - end loop; + -- Case of loop statement. Verify that the range is part of the + -- subtype indication of the iteration scheme. - if Present (Indic) then - Def_Id := Etype (Subtype_Mark (Indic)); + if Nkind (Insert_Node) = N_Loop_Statement then + declare + Indic : Node_Id; - Insert_Range_Checks - (R_Checks, - Insert_Node, - Def_Id, - Sloc (Insert_Node), - Do_Before => True); - end if; - end; + begin + Indic := Parent (R); + while Present (Indic) + and then Nkind (Indic) /= N_Subtype_Indication + loop + Indic := Parent (Indic); + end loop; + + if Present (Indic) then + Def_Id := Etype (Subtype_Mark (Indic)); - -- Case of declarations. If the declaration is for a type - -- and involves discriminants, the checks are premature at - -- the declaration point and need to wait for the expansion - -- of the initialization procedure, which will pass in the - -- list to put them on; otherwise, the checks are done at - -- the declaration point and there is no need to do them - -- again in the initialization procedure. + Insert_Range_Checks + (R_Checks, + Insert_Node, + Def_Id, + Sloc (Insert_Node), + Do_Before => True); + end if; + end; - elsif Nkind (Insert_Node) in N_Declaration then - Def_Id := Defining_Identifier (Insert_Node); + -- Case of declarations. If the declaration is for a type and + -- involves discriminants, the checks are premature at the + -- declaration point and need to wait for the expansion of the + -- initialization procedure, which will pass in the list to put + -- them on; otherwise, the checks are done at the declaration + -- point and there is no need to do them again in the + -- initialization procedure. - if (Ekind (Def_Id) = E_Record_Type - and then Depends_On_Discriminant (R)) - or else - (Ekind (Def_Id) = E_Protected_Type - and then Has_Discriminants (Def_Id)) - then - if Present (Check_List) then - Append_Range_Checks - (R_Checks, - Check_List, Def_Id, Sloc (Insert_Node)); - end if; + elsif Nkind (Insert_Node) in N_Declaration then + Def_Id := Defining_Identifier (Insert_Node); - else - if No (Check_List) then - Insert_Range_Checks - (R_Checks, - Insert_Node, Def_Id, Sloc (Insert_Node)); - end if; + if (Ekind (Def_Id) = E_Record_Type + and then Depends_On_Discriminant (R)) + or else + (Ekind (Def_Id) = E_Protected_Type + and then Has_Discriminants (Def_Id)) + then + if Present (Check_List) then + Append_Range_Checks + (R_Checks, + Check_List, Def_Id, Sloc (Insert_Node)); end if; - -- Case of statements. Drop the checks, as the range appears - -- in the context of a quantified expression. Insertion will - -- take place when expression is expanded. - else - null; + if No (Check_List) then + Insert_Range_Checks + (R_Checks, + Insert_Node, Def_Id, Sloc (Insert_Node)); + end if; end if; + + -- Case of statements. Drop the checks, as the range appears in + -- the context of a quantified expression. Insertion will take + -- place when expression is expanded. + + else + null; end if; end if; end if; diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads index eedb98c..f3722a0 100644 --- a/gcc/ada/sem_ch3.ads +++ b/gcc/ada/sem_ch3.ads @@ -257,11 +257,10 @@ package Sem_Ch3 is -- Priv_T is the private view of the type whose full declaration is in N. procedure Process_Range_Expr_In_Decl - (R : Node_Id; - T : Entity_Id; - Subtyp : Entity_Id := Empty; - Check_List : List_Id := No_List; - R_Check_Off : Boolean := False); + (R : Node_Id; + T : Entity_Id; + Subtyp : Entity_Id := Empty; + Check_List : List_Id := No_List); -- Process a range expression that appears in a declaration context. The -- range is analyzed and resolved with the base type of the given type, and -- an appropriate check for expressions in non-static contexts made on the @@ -271,8 +270,7 @@ package Sem_Ch3 is -- pointer of R so that the types get properly frozen. Check_List is used -- when the subprogram is called from Build_Record_Init_Proc and is used to -- return a set of constraint checking statements generated by the Checks - -- package. R_Check_Off is set to True when the call to Range_Check is to - -- be skipped. + -- package. -- -- If Subtyp is given, then the range is for the named subtype Subtyp, and -- in this case the bounds are captured if necessary using this name. diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 122a837..1fbe037 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -1308,15 +1308,11 @@ package body Sem_Elab is -- is set, then string " in SPARK" is added to the end of the message. procedure Info_Variable_Reference - (Ref : Node_Id; - Var_Id : Entity_Id; - Info_Msg : Boolean; - In_SPARK : Boolean); + (Ref : Node_Id; + Var_Id : Entity_Id); pragma Inline (Info_Variable_Reference); -- Output information concerning reference Ref which mentions variable - -- Var_Id. If flag Info_Msg is set, the routine emits an information - -- message, otherwise it emits an error. If flag In_SPARK is set, then - -- string " in SPARK" is added to the end of the message. + -- Var_Id. The routine emits an error suffixed with " in SPARK". end Diagnostics; use Diagnostics; @@ -3036,11 +3032,9 @@ package body Sem_Elab is pragma Inline (Nested_Scenarios); -- Obtain the list of scenarios associated with subprogram body N - procedure Set_Is_Traversed_Body - (N : Node_Id; - Val : Boolean := True); + procedure Set_Is_Traversed_Body (N : Node_Id); pragma Inline (Set_Is_Traversed_Body); - -- Mark subprogram body N as traversed depending on value Val + -- Mark subprogram body N as traversed procedure Set_Nested_Scenarios (N : Node_Id; @@ -3105,18 +3099,11 @@ package body Sem_Elab is -- Set_Is_Traversed_Body -- --------------------------- - procedure Set_Is_Traversed_Body - (N : Node_Id; - Val : Boolean := True) - is + procedure Set_Is_Traversed_Body (N : Node_Id) is pragma Assert (Present (N)); begin - if Val then - NE_Set.Insert (Traversed_Bodies_Set, N); - else - NE_Set.Delete (Traversed_Bodies_Set, N); - end if; + NE_Set.Insert (Traversed_Bodies_Set, N); end Set_Is_Traversed_Body; -------------------------- @@ -6697,10 +6684,8 @@ package body Sem_Elab is ----------------------------- procedure Info_Variable_Reference - (Ref : Node_Id; - Var_Id : Entity_Id; - Info_Msg : Boolean; - In_SPARK : Boolean) + (Ref : Node_Id; + Var_Id : Entity_Id) is begin if Is_Read (Ref) then @@ -6708,8 +6693,8 @@ package body Sem_Elab is (Msg => "read of variable & during elaboration", N => Ref, Id => Var_Id, - Info_Msg => Info_Msg, - In_SPARK => In_SPARK); + Info_Msg => False, + In_SPARK => True); end if; end Info_Variable_Reference; end Diagnostics; @@ -8638,10 +8623,8 @@ package body Sem_Elab is elsif Is_Suitable_Variable_Reference (N) then Info_Variable_Reference - (Ref => N, - Var_Id => Targ_Id, - Info_Msg => False, - In_SPARK => True); + (Ref => N, + Var_Id => Targ_Id); -- No other scenario may impose a requirement on the context of -- the main unit. @@ -11805,19 +11788,15 @@ package body Sem_Elab is -- by creating an entry for it in the ALI file of the main unit. Formal -- In_State denotes the current state of the Processing phase. - procedure Set_Is_Saved_Construct - (Constr : Entity_Id; - Val : Boolean := True); + procedure Set_Is_Saved_Construct (Constr : Entity_Id); pragma Inline (Set_Is_Saved_Construct); -- Mark invocation construct Constr as declared in the ALI file of the - -- main unit depending on value Val. + -- main unit. - procedure Set_Is_Saved_Relation - (Rel : Invoker_Target_Relation; - Val : Boolean := True); + procedure Set_Is_Saved_Relation (Rel : Invoker_Target_Relation); pragma Inline (Set_Is_Saved_Relation); -- Mark simple invocation relation Rel as recorded in the ALI file of - -- the main unit depending on value Val. + -- the main unit. function Target_Of (Pos : Active_Scenario_Pos; @@ -13307,34 +13286,20 @@ package body Sem_Elab is -- Set_Is_Saved_Construct -- ---------------------------- - procedure Set_Is_Saved_Construct - (Constr : Entity_Id; - Val : Boolean := True) - is + procedure Set_Is_Saved_Construct (Constr : Entity_Id) is pragma Assert (Present (Constr)); begin - if Val then - NE_Set.Insert (Saved_Constructs_Set, Constr); - else - NE_Set.Delete (Saved_Constructs_Set, Constr); - end if; + NE_Set.Insert (Saved_Constructs_Set, Constr); end Set_Is_Saved_Construct; --------------------------- -- Set_Is_Saved_Relation -- --------------------------- - procedure Set_Is_Saved_Relation - (Rel : Invoker_Target_Relation; - Val : Boolean := True) - is + procedure Set_Is_Saved_Relation (Rel : Invoker_Target_Relation) is begin - if Val then - IR_Set.Insert (Saved_Relations_Set, Rel); - else - IR_Set.Delete (Saved_Relations_Set, Rel); - end if; + IR_Set.Insert (Saved_Relations_Set, Rel); end Set_Is_Saved_Relation; ------------------ diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index 4c7833b..2e9d2c2 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -1184,7 +1184,6 @@ package body Treepr is Prefix : constant String := Prefix_Str & Prefix_Char; Sfile : Source_File_Index; - Fmt : UI_Format; begin if Phase /= Printing then @@ -1400,12 +1399,6 @@ package body Treepr is end if; end if; - if Nkind (N) = N_Integer_Literal and then Print_In_Hex (N) then - Fmt := Hex; - else - Fmt := Auto; - end if; - declare Fields : Node_Field_Array renames Node_Field_Table (Nkind (N)).all; Should_Print : constant Node_Field_Set := @@ -1440,6 +1433,12 @@ package body Treepr is => False, others => True); + + Fmt : constant UI_Format := + (if Nkind (N) = N_Integer_Literal and then Print_In_Hex (N) + then Hex + else Auto); + begin -- Outer loop makes flags come out last @@ -2054,25 +2053,16 @@ package body Treepr is New_Prefix : String (Prefix_Str'First .. Prefix_Str'Last + 2); -- Prefix string for printing referenced fields - procedure Visit_Descendant - (D : Union_Id; - No_Indent : Boolean := False); + procedure Visit_Descendant (D : Union_Id); -- This procedure tests the given value of one of the Fields referenced -- by the current node to determine whether to visit it recursively. - -- Normally No_Indent is false, which means that the visited node will - -- be indented using New_Prefix. If No_Indent is set to True, then - -- this indentation is skipped, and Prefix_Str is used for the call - -- to print the descendant. No_Indent is effective only if the - -- referenced descendant is a node. + -- The visited node will be indented using New_Prefix. ---------------------- -- Visit_Descendant -- ---------------------- - procedure Visit_Descendant - (D : Union_Id; - No_Indent : Boolean := False) - is + procedure Visit_Descendant (D : Union_Id) is begin -- Case of descendant is a node @@ -2145,11 +2135,7 @@ package body Treepr is -- execute a return if the node is not to be visited), we can -- go ahead and visit the node. - if No_Indent then - Visit_Node (Nod, Prefix_Str, Prefix_Char); - else - Visit_Node (Nod, New_Prefix, ' '); - end if; + Visit_Node (Nod, New_Prefix, ' '); end; -- Case of descendant is a list -- cgit v1.1