FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[Ada] Remove constant arguments

Browse source 
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.
This commit is contained in:
Etienne Servais 2021-09-29 15:22:00 +02:00 • committed by Pierre-Marie de Rodat
parent d64c67d67d
commit 35338c60e4
12 changed files with 157 additions and 245 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
gcc/ada/ali.adb
View file

@ -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

14
gcc/ada/bindo-graphs.adb
View file

@ -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;
------------------------

8
gcc/ada/cstand.adb
View file

@ -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

16
gcc/ada/exp_ch3.adb
View file

@ -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;
---------------------------------

6
gcc/ada/exp_dist.adb
View file

@ -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_

16
gcc/ada/gnatls.adb
View file

@ -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;

10
gcc/ada/sem_ch10.adb
View file

@ -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;

9
gcc/ada/sem_ch10.ads
View file

@ -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

183
gcc/ada/sem_ch3.adb
View file

@ -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);
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.
-- 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;
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;
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;
Insert_Node := Parent (Insert_Node);
end loop;
-- Why would Type_Decl not be present??? Without this test,
-- short regression tests fail.
-- Why would Type_Decl not be present??? Without this test,
-- short regression tests fail.
if Present (Insert_Node) then
if Present (Insert_Node) then
-- Case of loop statement. Verify that the range is part
-- of the subtype indication of the iteration scheme.
-- Case of loop statement. Verify that the range is part of the
-- subtype indication of the iteration scheme.
if Nkind (Insert_Node) = N_Loop_Statement then
declare
Indic : Node_Id;
if Nkind (Insert_Node) = N_Loop_Statement then
declare
Indic : Node_Id;
begin
Indic := Parent (R);
while Present (Indic)
and then Nkind (Indic) /= N_Subtype_Indication
loop
Indic := Parent (Indic);
end loop;
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));
if Present (Indic) then
Def_Id := Etype (Subtype_Mark (Indic));
Insert_Range_Checks
(R_Checks,
Insert_Node,
Def_Id,
Sloc (Insert_Node),
Do_Before => True);
end if;
end;
Insert_Range_Checks
(R_Checks,
Insert_Node,
Def_Id,
Sloc (Insert_Node),
Do_Before => True);
end if;
end;
-- 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.
-- 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.
elsif Nkind (Insert_Node) in N_Declaration then
Def_Id := Defining_Identifier (Insert_Node);
elsif Nkind (Insert_Node) in N_Declaration then
Def_Id := Defining_Identifier (Insert_Node);
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;
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;

12
gcc/ada/sem_ch3.ads
View file

@ -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.

77
gcc/ada/sem_elab.adb
View file

@ -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;
------------------

34
gcc/ada/treepr.adb
View file

@ -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