public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-4305] [Ada] Remove constant arguments
@ 2021-10-11 13:40 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-10-11 13:40 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:35338c60e4634e29d8704df6e7012fcdc7eb909c
commit r12-4305-g35338c60e4634e29d8704df6e7012fcdc7eb909c
Author: Etienne Servais <servais@adacore.com>
Date: Wed Sep 29 15:22:00 2021 +0200
[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.
Diff:
---
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 3815a70c051..88cc247888c 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 011b0f48fcb..09899813a76 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 409944c6bea..41de2a57476 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 702c7da76e0..1f4f19189ab 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 5cb8fb54993..41c0aea8a36 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 c676996670e..68990e19605 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 dd78501025a..75a03797c2d 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 fbaf3ca0b25..ecf3151a515 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 f1a56ad2b77..57db6378579 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 eedb98caf12..f3722a0e7d5 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 122a8371117..1fbe0377a66 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 4c7833beade..2e9d2c27808 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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-10-11 13:40 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-10-11 13:40 [gcc r12-4305] [Ada] Remove constant arguments Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).