Skip to content

R
riscv-gcc-1
Commit 191fcb3a by Robert Dewar Committed by Arnaud Charlet
Options

checks.adb, [...]: Minor code reorganization. 

2010-06-17  Robert Dewar  <dewar@adacore.com>

	* checks.adb, exp_aggr.adb, exp_atag.adb, exp_attr.adb, exp_ch11.adb,
	exp_ch3.adb, exp_ch4.adb: Minor code reorganization.
	Use Make_Temporary.
	* tbuild.ads, tbuild.adb (Make_Temporary): Clean up, use Entity_Id
	instead of Node_Id.
	(Make_Temporary): Add more extensive documentation

From-SVN: r160893
parent 8a95f4e8
Showing with 122 additions and 198 deletions
gcc/ada/ChangeLog
2010-06-17 Robert Dewar <dewar@adacore.com> 2010-06-17 Robert Dewar <dewar@adacore.com>
* checks.adb, exp_aggr.adb, exp_atag.adb, exp_attr.adb, exp_ch11.adb,
exp_ch3.adb, exp_ch4.adb: Minor code reorganization.
Use Make_Temporary.
* tbuild.ads, tbuild.adb (Make_Temporary): Clean up, use Entity_Id
instead of Node_Id.
(Make_Temporary): Add more extensive documentation
2010-06-17 Robert Dewar <dewar@adacore.com>
* sem_intr.adb, sem_prag.adb, sem_res.adb, sem_type.adb, sem_util.adb, * sem_intr.adb, sem_prag.adb, sem_res.adb, sem_type.adb, sem_util.adb,
sem_warn.adb, sem_eval.adb: Minor reformatting. Use Ekind_In. sem_warn.adb, sem_eval.adb: Minor reformatting. Use Ekind_In.
(Set_Slice_Subtype): Explicitly freeze the slice's itype at the point (Set_Slice_Subtype): Explicitly freeze the slice's itype at the point
......
gcc/ada/checks.adb
...@@ -1584,9 +1584,7 @@ package body Checks is ...@@ -1584,9 +1584,7 @@ package body Checks is
pragma Assert (Target_Base /= Target_Typ); pragma Assert (Target_Base /= Target_Typ);
Temp : constant Entity_Id := Temp : constant Entity_Id := Make_Temporary (Loc, 'T', Par);
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('T'));
begin begin
Apply_Float_Conversion_Check (Ck_Node, Target_Base); Apply_Float_Conversion_Check (Ck_Node, Target_Base);
...@@ -4707,9 +4705,7 @@ package body Checks is ...@@ -4707,9 +4705,7 @@ package body Checks is
-- Then the conversion itself is replaced by an occurrence of Tnn -- Then the conversion itself is replaced by an occurrence of Tnn
declare declare
Tnn : constant Entity_Id := Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', N);
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('T'));
begin begin
Insert_Actions (N, New_List ( Insert_Actions (N, New_List (
...@@ -4860,9 +4856,7 @@ package body Checks is ...@@ -4860,9 +4856,7 @@ package body Checks is
-- the value is non-negative -- the value is non-negative
declare declare
Tnn : constant Entity_Id := Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', N);
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('T'));
begin begin
Insert_Actions (N, New_List ( Insert_Actions (N, New_List (
......
gcc/ada/exp_aggr.adb
...@@ -1347,7 +1347,7 @@ package body Exp_Aggr is ...@@ -1347,7 +1347,7 @@ package body Exp_Aggr is
-- Otherwise construct the loop, starting with the loop index L_J -- Otherwise construct the loop, starting with the loop index L_J
L_J := Make_Defining_Identifier (Loc, New_Internal_Name ('J')); L_J := Make_Temporary (Loc, 'J', L);
-- Construct "L .. H" in Index_Base. We use a qualified expression -- Construct "L .. H" in Index_Base. We use a qualified expression
-- for the bound to convert to the index base, but we don't need -- for the bound to convert to the index base, but we don't need
...@@ -1455,7 +1455,7 @@ package body Exp_Aggr is ...@@ -1455,7 +1455,7 @@ package body Exp_Aggr is
-- Build the decl of W_J -- Build the decl of W_J
W_J := Make_Defining_Identifier (Loc, New_Internal_Name ('J')); W_J := Make_Temporary (Loc, 'J', L);
W_Decl := W_Decl :=
Make_Object_Declaration Make_Object_Declaration
(Loc, (Loc,
...@@ -3008,9 +3008,7 @@ package body Exp_Aggr is ...@@ -3008,9 +3008,7 @@ package body Exp_Aggr is
-- the corresponding aggregate. -- the corresponding aggregate.
declare declare
SubE : constant Entity_Id := SubE : constant Entity_Id := Make_Temporary (Loc, 'T');
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('T'));
SubD : constant Node_Id := SubD : constant Node_Id :=
Make_Subtype_Declaration (Loc, Make_Subtype_Declaration (Loc,
...@@ -4139,7 +4137,7 @@ package body Exp_Aggr is ...@@ -4139,7 +4137,7 @@ package body Exp_Aggr is
procedure Build_Constrained_Type (Positional : Boolean) is procedure Build_Constrained_Type (Positional : Boolean) is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
Agg_Type : Entity_Id; Agg_Type : constant Entity_Id := Make_Temporary (Loc, 'A');
Comp : Node_Id; Comp : Node_Id;
Decl : Node_Id; Decl : Node_Id;
Typ : constant Entity_Id := Etype (N); Typ : constant Entity_Id := Etype (N);
...@@ -4148,10 +4146,6 @@ package body Exp_Aggr is ...@@ -4148,10 +4146,6 @@ package body Exp_Aggr is
Sub_Agg : Node_Id; Sub_Agg : Node_Id;
begin begin
Agg_Type :=
Make_Defining_Identifier (
Loc, New_Internal_Name ('A'));
-- If the aggregate is purely positional, all its subaggregates -- If the aggregate is purely positional, all its subaggregates
-- have the same size. We collect the dimensions from the first -- have the same size. We collect the dimensions from the first
-- subaggregate at each level. -- subaggregate at each level.
...@@ -4169,19 +4163,16 @@ package body Exp_Aggr is ...@@ -4169,19 +4163,16 @@ package body Exp_Aggr is
Next (Comp); Next (Comp);
end loop; end loop;
Append ( Append_To (Indices,
Make_Range (Loc, Make_Range (Loc,
Low_Bound => Make_Integer_Literal (Loc, 1), Low_Bound => Make_Integer_Literal (Loc, 1),
High_Bound => High_Bound => Make_Integer_Literal (Loc, Num)));
Make_Integer_Literal (Loc, Num)),
Indices);
end loop; end loop;
else else
-- We know the aggregate type is unconstrained and the aggregate -- We know the aggregate type is unconstrained and the aggregate
-- is not processable by the back end, therefore not necessarily -- is not processable by the back end, therefore not necessarily
-- positional. Retrieve each dimension bounds (computed earlier). -- positional. Retrieve each dimension bounds (computed earlier).
-- earlier.
for D in 1 .. Number_Dimensions (Typ) loop for D in 1 .. Number_Dimensions (Typ) loop
Append ( Append (
...@@ -5693,9 +5684,7 @@ package body Exp_Aggr is ...@@ -5693,9 +5684,7 @@ package body Exp_Aggr is
Decl := Decl :=
Make_Subtype_Declaration (Loc, Make_Subtype_Declaration (Loc,
Defining_Identifier => Defining_Identifier => Make_Temporary (Loc, 'T'),
Make_Defining_Identifier (Loc,
New_Internal_Name ('T')),
Subtype_Indication => Subtype_Indication =>
Make_Subtype_Indication (Loc, Make_Subtype_Indication (Loc,
Subtype_Mark => Subtype_Mark =>
...@@ -6384,9 +6373,8 @@ package body Exp_Aggr is ...@@ -6384,9 +6373,8 @@ package body Exp_Aggr is
and then Nkind (First (Choices (First (Component_Associations (N))))) and then Nkind (First (Choices (First (Component_Associations (N)))))
= N_Others_Choice = N_Others_Choice
then then
Expr := Expr := Expression (First (Component_Associations (N)));
Expression (First (Component_Associations (N))); L_J := Make_Temporary (Loc, 'J');
L_J := Make_Defining_Identifier (Loc, New_Internal_Name ('J'));
L_Iter := L_Iter :=
Make_Iteration_Scheme (Loc, Make_Iteration_Scheme (Loc,
......
gcc/ada/exp_atag.adb
...@@ -150,14 +150,10 @@ package body Exp_Atag is ...@@ -150,14 +150,10 @@ package body Exp_Atag is
Related_Nod : Node_Id; Related_Nod : Node_Id;
New_Node : out Node_Id) New_Node : out Node_Id)
is is
Tag_Addr : constant Entity_Id := Make_Defining_Identifier (Loc, Tag_Addr : constant Entity_Id := Make_Temporary (Loc, 'D', Obj_Tag_Node);
New_Internal_Name ('D')); Obj_TSD : constant Entity_Id := Make_Temporary (Loc, 'D');
Obj_TSD : constant Entity_Id := Make_Defining_Identifier (Loc, Typ_TSD : constant Entity_Id := Make_Temporary (Loc, 'D');
New_Internal_Name ('D')); Index : constant Entity_Id := Make_Temporary (Loc, 'D');
Typ_TSD : constant Entity_Id := Make_Defining_Identifier (Loc,
New_Internal_Name ('D'));
Index : constant Entity_Id := Make_Defining_Identifier (Loc,
New_Internal_Name ('D'));
begin begin
-- Generate: -- Generate:
......
gcc/ada/exp_attr.adb
...@@ -530,9 +530,7 @@ package body Exp_Attr is ...@@ -530,9 +530,7 @@ package body Exp_Attr is
and then Is_Written and then Is_Written
then then
declare declare
Temp : constant Entity_Id := Temp : constant Entity_Id := Make_Temporary (Loc, 'V');
Make_Defining_Identifier
(Loc, New_Internal_Name ('V'));
Decl : Node_Id; Decl : Node_Id;
Assn : Node_Id; Assn : Node_Id;
...@@ -1263,8 +1261,7 @@ package body Exp_Attr is ...@@ -1263,8 +1261,7 @@ package body Exp_Attr is
-- returned is a copy of the library string in gnatvsn.ads. -- returned is a copy of the library string in gnatvsn.ads.
when Attribute_Body_Version | Attribute_Version => Version : declare when Attribute_Body_Version | Attribute_Version => Version : declare
E : constant Entity_Id := E : constant Entity_Id := Make_Temporary (Loc, 'V');
Make_Defining_Identifier (Loc, New_Internal_Name ('V'));
Pent : Entity_Id; Pent : Entity_Id;
S : String_Id; S : String_Id;
...@@ -1777,9 +1774,7 @@ package body Exp_Attr is ...@@ -1777,9 +1774,7 @@ package body Exp_Attr is
Attribute_Elab_Spec => Attribute_Elab_Spec =>
Elab_Body : declare Elab_Body : declare
Ent : constant Entity_Id := Ent : constant Entity_Id := Make_Temporary (Loc, 'E');
Make_Defining_Identifier (Loc,
New_Internal_Name ('E'));
Str : String_Id; Str : String_Id;
Lang : Node_Id; Lang : Node_Id;
...@@ -2389,13 +2384,14 @@ package body Exp_Attr is ...@@ -2389,13 +2384,14 @@ package body Exp_Attr is
Rtyp : constant Entity_Id := Root_Type (P_Type); Rtyp : constant Entity_Id := Root_Type (P_Type);
Dnn : Entity_Id; Dnn : Entity_Id;
Decl : Node_Id; Decl : Node_Id;
Expr : Node_Id;
begin begin
-- Read the internal tag (RM 13.13.2(34)) and use it to -- Read the internal tag (RM 13.13.2(34)) and use it to
-- initialize a dummy tag object: -- initialize a dummy tag object:
-- Dnn : Ada.Tags.Tag -- Dnn : Ada.Tags.Tag :=
-- := Descendant_Tag (String'Input (Strm), P_Type); -- Descendant_Tag (String'Input (Strm), P_Type);
-- This dummy object is used only to provide a controlling -- This dummy object is used only to provide a controlling
-- argument for the eventual _Input call. Descendant_Tag is -- argument for the eventual _Input call. Descendant_Tag is
...@@ -2406,30 +2402,28 @@ package body Exp_Attr is ...@@ -2406,30 +2402,28 @@ package body Exp_Attr is
-- required for Ada 2005 because tagged types can be -- required for Ada 2005 because tagged types can be
-- extended in nested scopes (AI-344). -- extended in nested scopes (AI-344).
Dnn := Expr :=
Make_Defining_Identifier (Loc, Make_Function_Call (Loc,
Chars => New_Internal_Name ('D')); Name =>
New_Occurrence_Of (RTE (RE_Descendant_Tag), Loc),
Parameter_Associations => New_List (
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Standard_String, Loc),
Attribute_Name => Name_Input,
Expressions => New_List (
Relocate_Node (Duplicate_Subexpr (Strm)))),
Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (P_Type, Loc),
Attribute_Name => Name_Tag)));
Dnn := Make_Temporary (Loc, 'D', Expr);
Decl := Decl :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => Dnn, Defining_Identifier => Dnn,
Object_Definition => Object_Definition =>
New_Occurrence_Of (RTE (RE_Tag), Loc), New_Occurrence_Of (RTE (RE_Tag), Loc),
Expression => Expression => Expr);
Make_Function_Call (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Descendant_Tag), Loc),
Parameter_Associations => New_List (
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Standard_String, Loc),
Attribute_Name => Name_Input,
Expressions => New_List (
Relocate_Node
(Duplicate_Subexpr (Strm)))),
Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (P_Type, Loc),
Attribute_Name => Name_Tag))));
Insert_Action (N, Decl); Insert_Action (N, Decl);
...@@ -2440,8 +2434,9 @@ package body Exp_Attr is ...@@ -2440,8 +2434,9 @@ package body Exp_Attr is
-- tagged object). -- tagged object).
Fname := Find_Prim_Op (Rtyp, TSS_Stream_Input); Fname := Find_Prim_Op (Rtyp, TSS_Stream_Input);
Cntrl := Unchecked_Convert_To (P_Type, Cntrl :=
New_Occurrence_Of (Dnn, Loc)); Unchecked_Convert_To (P_Type,
New_Occurrence_Of (Dnn, Loc));
Set_Etype (Cntrl, P_Type); Set_Etype (Cntrl, P_Type);
Set_Parent (Cntrl, N); Set_Parent (Cntrl, N);
end; end;
...@@ -2987,9 +2982,7 @@ package body Exp_Attr is ...@@ -2987,9 +2982,7 @@ package body Exp_Attr is
--------- ---------
when Attribute_Old => Old : declare when Attribute_Old => Old : declare
Tnn : constant Entity_Id := Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', Pref);
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('T'));
Subp : Node_Id; Subp : Node_Id;
Asn_Stm : Node_Id; Asn_Stm : Node_Id;
...@@ -4552,8 +4545,7 @@ package body Exp_Attr is ...@@ -4552,8 +4545,7 @@ package body Exp_Attr is
----------------- -----------------
when Attribute_UET_Address => UET_Address : declare when Attribute_UET_Address => UET_Address : declare
Ent : constant Entity_Id := Ent : constant Entity_Id := Make_Temporary (Loc, 'T');
Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
begin begin
Insert_Action (N, Insert_Action (N,
......
gcc/ada/exp_ch11.adb
...@@ -469,9 +469,7 @@ package body Exp_Ch11 is ...@@ -469,9 +469,7 @@ package body Exp_Ch11 is
Local_Expansion_Required := True; Local_Expansion_Required := True;
declare declare
L : constant Entity_Id := L : constant Entity_Id := Make_Temporary (Sloc (H), 'L');
Make_Defining_Identifier (Sloc (H),
Chars => New_Internal_Name ('L'));
begin begin
Set_Exception_Label (H, L); Set_Exception_Label (H, L);
Add_Label_Declaration (L); Add_Label_Declaration (L);
...@@ -646,9 +644,7 @@ package body Exp_Ch11 is ...@@ -646,9 +644,7 @@ package body Exp_Ch11 is
declare declare
-- L3 is the label to exit the HSS -- L3 is the label to exit the HSS
L3_Dent : constant Entity_Id := L3_Dent : constant Entity_Id := Make_Temporary (Loc, 'L');
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('L'));
Labl_L3 : constant Node_Id := Labl_L3 : constant Node_Id :=
Make_Label (Loc, Make_Label (Loc,
...@@ -1560,6 +1556,8 @@ package body Exp_Ch11 is ...@@ -1560,6 +1556,8 @@ package body Exp_Ch11 is
-- mechanism. However we need to keep the expansion for "raise;" -- mechanism. However we need to keep the expansion for "raise;"
-- statements. See 4jexcept.ads for details. -- statements. See 4jexcept.ads for details.
-- What is .NET status, either code or comment is wrong here ???
if Present (Name (N)) and then VM_Target /= No_VM then if Present (Name (N)) and then VM_Target /= No_VM then
return; return;
end if; end if;
...@@ -1686,7 +1684,7 @@ package body Exp_Ch11 is ...@@ -1686,7 +1684,7 @@ package body Exp_Ch11 is
-- be referencing this entity by normal visibility methods. -- be referencing this entity by normal visibility methods.
if No (Choice_Parameter (Ehand)) then if No (Choice_Parameter (Ehand)) then
E := Make_Defining_Identifier (Loc, New_Internal_Name ('E')); E := Make_Temporary (Loc, 'E');
Set_Choice_Parameter (Ehand, E); Set_Choice_Parameter (Ehand, E);
Set_Ekind (E, E_Variable); Set_Ekind (E, E_Variable);
Set_Etype (E, RTE (RE_Exception_Occurrence)); Set_Etype (E, RTE (RE_Exception_Occurrence));
......
gcc/ada/exp_ch3.adb
...@@ -504,7 +504,7 @@ package body Exp_Ch3 is ...@@ -504,7 +504,7 @@ package body Exp_Ch3 is
-- And insert this declaration into the tree. The type of the -- And insert this declaration into the tree. The type of the
-- discriminant is then reset to this more restricted subtype. -- discriminant is then reset to this more restricted subtype.
Tnn := Make_Defining_Identifier (Loc, New_Internal_Name ('T')); Tnn := Make_Temporary (Loc, 'T');
Insert_Action (Declaration_Node (Rtype), Insert_Action (Declaration_Node (Rtype),
Make_Subtype_Declaration (Loc, Make_Subtype_Declaration (Loc,
...@@ -2115,10 +2115,7 @@ package body Exp_Ch3 is ...@@ -2115,10 +2115,7 @@ package body Exp_Ch3 is
Spec_Node : Node_Id; Spec_Node : Node_Id;
begin begin
Func_Id := Func_Id := Make_Temporary (Loc, 'F');
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('F'));
Set_DT_Offset_To_Top_Func (Iface_Comp, Func_Id); Set_DT_Offset_To_Top_Func (Iface_Comp, Func_Id);
-- Generate -- Generate
...@@ -2246,9 +2243,7 @@ package body Exp_Ch3 is ...@@ -2246,9 +2243,7 @@ package body Exp_Ch3 is
if Is_Tagged_Type (Rec_Type) if Is_Tagged_Type (Rec_Type)
and then not Is_CPP_Class (Rec_Type) and then not Is_CPP_Class (Rec_Type)
then then
Set_Tag := Set_Tag := Make_Temporary (Loc, 'P');
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('P'));
Append_To (Parameters, Append_To (Parameters,
Make_Parameter_Specification (Loc, Make_Parameter_Specification (Loc,
...@@ -3404,37 +3399,21 @@ package body Exp_Ch3 is ...@@ -3404,37 +3399,21 @@ package body Exp_Ch3 is
Loc : constant Source_Ptr := Sloc (Typ); Loc : constant Source_Ptr := Sloc (Typ);
Index : constant Entity_Id := Base_Type (Etype (First_Index (Typ))); Index : constant Entity_Id := Base_Type (Etype (First_Index (Typ)));
-- Build formal parameters of procedure Larray : constant Entity_Id := Make_Temporary (Loc, 'A');
Rarray : constant Entity_Id := Make_Temporary (Loc, 'R');
Larray : constant Entity_Id := Left_Lo : constant Entity_Id := Make_Temporary (Loc, 'L');
Make_Defining_Identifier Left_Hi : constant Entity_Id := Make_Temporary (Loc, 'L');
(Loc, Chars => New_Internal_Name ('A')); Right_Lo : constant Entity_Id := Make_Temporary (Loc, 'R');
Rarray : constant Entity_Id := Right_Hi : constant Entity_Id := Make_Temporary (Loc, 'R');
Make_Defining_Identifier Rev : constant Entity_Id := Make_Temporary (Loc, 'D');
(Loc, Chars => New_Internal_Name ('R')); -- Formal parameters of procedure
Left_Lo : constant Entity_Id :=
Make_Defining_Identifier
(Loc, Chars => New_Internal_Name ('L'));
Left_Hi : constant Entity_Id :=
Make_Defining_Identifier
(Loc, Chars => New_Internal_Name ('L'));
Right_Lo : constant Entity_Id :=
Make_Defining_Identifier
(Loc, Chars => New_Internal_Name ('R'));
Right_Hi : constant Entity_Id :=
Make_Defining_Identifier
(Loc, Chars => New_Internal_Name ('R'));
Rev : constant Entity_Id :=
Make_Defining_Identifier
(Loc, Chars => New_Internal_Name ('D'));
Proc_Name : constant Entity_Id := Proc_Name : constant Entity_Id :=
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
Chars => Make_TSS_Name (Typ, TSS_Slice_Assign)); Chars => Make_TSS_Name (Typ, TSS_Slice_Assign));
Lnn : constant Entity_Id := Lnn : constant Entity_Id := Make_Temporary (Loc, 'L');
Make_Defining_Identifier (Loc, New_Internal_Name ('L')); Rnn : constant Entity_Id := Make_Temporary (Loc, 'R');
Rnn : constant Entity_Id :=
Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
-- Subscripts for left and right sides -- Subscripts for left and right sides
Decls : List_Id; Decls : List_Id;
...@@ -4620,8 +4599,7 @@ package body Exp_Ch3 is ...@@ -4620,8 +4599,7 @@ package body Exp_Ch3 is
Decl_1 := Decl_1 :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => Defining_Identifier =>
Make_Defining_Identifier (Loc, Make_Temporary (Loc, 'D', Expr_N),
New_Internal_Name ('D')),
Object_Definition => Object_Definition =>
New_Occurrence_Of (Expr_Typ, Loc), New_Occurrence_Of (Expr_Typ, Loc),
Expression => Expression =>
...@@ -4633,12 +4611,9 @@ package body Exp_Ch3 is ...@@ -4633,12 +4611,9 @@ package body Exp_Ch3 is
Decl_2 := Decl_2 :=
Make_Object_Renaming_Declaration (Loc, Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Defining_Identifier => Make_Temporary (Loc, 'D'),
Make_Defining_Identifier (Loc, Subtype_Mark => New_Occurrence_Of (Typ, Loc),
New_Internal_Name ('D')), Name =>
Subtype_Mark =>
New_Occurrence_Of (Typ, Loc),
Name =>
Unchecked_Convert_To (Typ, Unchecked_Convert_To (Typ,
Make_Selected_Component (Loc, Make_Selected_Component (Loc,
Prefix => Prefix =>
...@@ -4682,23 +4657,19 @@ package body Exp_Ch3 is ...@@ -4682,23 +4657,19 @@ package body Exp_Ch3 is
Decl_1 := Decl_1 :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => Defining_Identifier =>
Make_Defining_Identifier (Loc, Make_Temporary (Loc, 'D', New_Expr),
New_Internal_Name ('D')), Object_Definition =>
Object_Definition =>
New_Occurrence_Of New_Occurrence_Of
(Etype (Object_Definition (N)), Loc), (Etype (Object_Definition (N)), Loc),
Expression => Expression =>
Unchecked_Convert_To Unchecked_Convert_To
(Etype (Object_Definition (N)), New_Expr)); (Etype (Object_Definition (N)), New_Expr));
Decl_2 := Decl_2 :=
Make_Object_Renaming_Declaration (Loc, Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Defining_Identifier => Make_Temporary (Loc, 'D'),
Make_Defining_Identifier (Loc, Subtype_Mark => New_Occurrence_Of (Typ, Loc),
New_Internal_Name ('D')), Name =>
Subtype_Mark =>
New_Occurrence_Of (Typ, Loc),
Name =>
Unchecked_Convert_To (Typ, Unchecked_Convert_To (Typ,
Make_Explicit_Dereference (Loc, Make_Explicit_Dereference (Loc,
Unchecked_Convert_To (RTE (RE_Tag_Ptr), Unchecked_Convert_To (RTE (RE_Tag_Ptr),
......
gcc/ada/exp_ch4.adb
...@@ -595,7 +595,7 @@ package body Exp_Ch4 is ...@@ -595,7 +595,7 @@ package body Exp_Ch4 is
Set_Analyzed (Node); Set_Analyzed (Node);
Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('P')); Temp := Make_Temporary (Loc, 'P', Node);
Insert_Action (N, Insert_Action (N,
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
...@@ -664,8 +664,7 @@ package body Exp_Ch4 is ...@@ -664,8 +664,7 @@ package body Exp_Ch4 is
Remove_Side_Effects (Exp); Remove_Side_Effects (Exp);
end if; end if;
Temp := Temp := Make_Temporary (Loc, 'P');
Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
-- For a class wide allocation generate the following code: -- For a class wide allocation generate the following code:
...@@ -755,9 +754,7 @@ package body Exp_Ch4 is ...@@ -755,9 +754,7 @@ package body Exp_Ch4 is
else else
declare declare
Def_Id : constant Entity_Id := Def_Id : constant Entity_Id := Make_Temporary (Loc, 'T');
Make_Defining_Identifier (Loc,
New_Internal_Name ('T'));
New_Decl : Node_Id; New_Decl : Node_Id;
begin begin
...@@ -834,8 +831,7 @@ package body Exp_Ch4 is ...@@ -834,8 +831,7 @@ package body Exp_Ch4 is
New_Decl := New_Decl :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => Make_Defining_Identifier (Loc, Defining_Identifier => Make_Temporary (Loc, 'P'),
New_Internal_Name ('P')),
Object_Definition => New_Reference_To (PtrT, Loc), Object_Definition => New_Reference_To (PtrT, Loc),
Expression => Unchecked_Convert_To (PtrT, Expression => Unchecked_Convert_To (PtrT,
New_Reference_To (Temp, Loc))); New_Reference_To (Temp, Loc)));
...@@ -916,16 +912,13 @@ package body Exp_Ch4 is ...@@ -916,16 +912,13 @@ package body Exp_Ch4 is
if Is_RTE (Apool, RE_SS_Pool) then if Is_RTE (Apool, RE_SS_Pool) then
declare declare
F : constant Entity_Id := F : constant Entity_Id := Make_Temporary (Loc, 'F');
Make_Defining_Identifier (Loc,
New_Internal_Name ('F'));
begin begin
Insert_Action (N, Insert_Action (N,
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => F, Defining_Identifier => F,
Object_Definition => New_Reference_To (RTE Object_Definition =>
(RE_Finalizable_Ptr), Loc))); New_Reference_To (RTE (RE_Finalizable_Ptr), Loc)));
Flist := New_Reference_To (F, Loc); Flist := New_Reference_To (F, Loc);
Attach := Make_Integer_Literal (Loc, 1); Attach := Make_Integer_Literal (Loc, 1);
end; end;
...@@ -991,8 +984,7 @@ package body Exp_Ch4 is ...@@ -991,8 +984,7 @@ package body Exp_Ch4 is
end if; end if;
elsif Aggr_In_Place then elsif Aggr_In_Place then
Temp := Temp := Make_Temporary (Loc, 'P');
Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
Tmp_Node := Tmp_Node :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => Temp, Defining_Identifier => Temp,
...@@ -1076,9 +1068,7 @@ package body Exp_Ch4 is ...@@ -1076,9 +1068,7 @@ package body Exp_Ch4 is
and then Is_Packed (T) and then Is_Packed (T)
then then
declare declare
ConstrT : constant Entity_Id := ConstrT : constant Entity_Id := Make_Temporary (Loc, 'A');
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('A'));
Internal_Exp : constant Node_Id := Relocate_Node (Exp); Internal_Exp : constant Node_Id := Relocate_Node (Exp);
begin begin
Insert_Action (Exp, Insert_Action (Exp,
...@@ -1598,8 +1588,7 @@ package body Exp_Ch4 is ...@@ -1598,8 +1588,7 @@ package body Exp_Ch4 is
-- constrained types, then we can use the same index for both -- constrained types, then we can use the same index for both
-- of the arrays. -- of the arrays.
An : constant Entity_Id := Make_Defining_Identifier (Loc, An : constant Entity_Id := Make_Temporary (Loc, 'A');
Chars => New_Internal_Name ('A'));
Bn : Entity_Id; Bn : Entity_Id;
Index_T : Entity_Id; Index_T : Entity_Id;
...@@ -1616,9 +1605,7 @@ package body Exp_Ch4 is ...@@ -1616,9 +1605,7 @@ package body Exp_Ch4 is
Index_T := Base_Type (Etype (Index)); Index_T := Base_Type (Etype (Index));
if Need_Separate_Indexes then if Need_Separate_Indexes then
Bn := Bn := Make_Temporary (Loc, 'B');
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('B'));
else else
Bn := An; Bn := An;
end if; end if;
...@@ -1805,7 +1792,7 @@ package body Exp_Ch4 is ...@@ -1805,7 +1792,7 @@ package body Exp_Ch4 is
Defining_Identifier => B, Defining_Identifier => B,
Parameter_Type => New_Reference_To (Rtyp, Loc))); Parameter_Type => New_Reference_To (Rtyp, Loc)));
Func_Name := Make_Defining_Identifier (Loc, New_Internal_Name ('E')); Func_Name := Make_Temporary (Loc, 'E');
-- Build statement sequence for function -- Build statement sequence for function
...@@ -2625,9 +2612,7 @@ package body Exp_Ch4 is ...@@ -2625,9 +2612,7 @@ package body Exp_Ch4 is
Operands (NN) := Opnd; Operands (NN) := Opnd;
Is_Fixed_Length (NN) := False; Is_Fixed_Length (NN) := False;
Var_Length (NN) := Var_Length (NN) := Make_Temporary (Loc, 'L');
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('L'));
Append_To (Actions, Append_To (Actions,
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
...@@ -2674,9 +2659,7 @@ package body Exp_Ch4 is ...@@ -2674,9 +2659,7 @@ package body Exp_Ch4 is
-- create an entity initialized to this length. -- create an entity initialized to this length.
else else
Ent := Ent := Make_Temporary (Loc, 'L');
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('L'));
if Is_Fixed_Length (NN) then if Is_Fixed_Length (NN) then
Clen := Make_Integer_Literal (Loc, Fixed_Length (NN)); Clen := Make_Integer_Literal (Loc, Fixed_Length (NN));
...@@ -2794,8 +2777,7 @@ package body Exp_Ch4 is ...@@ -2794,8 +2777,7 @@ package body Exp_Ch4 is
end Get_Known_Bound; end Get_Known_Bound;
begin begin
Ent := Ent := Make_Temporary (Loc, 'L');
Make_Defining_Identifier (Loc, Chars => New_Internal_Name ('L'));
Append_To (Actions, Append_To (Actions,
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
...@@ -2851,9 +2833,7 @@ package body Exp_Ch4 is ...@@ -2851,9 +2833,7 @@ package body Exp_Ch4 is
-- Now we construct an array object with appropriate bounds -- Now we construct an array object with appropriate bounds
Ent := Ent := Make_Temporary (Loc, 'S');
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('S'));
-- If the bound is statically known to be out of range, we do not want -- If the bound is statically known to be out of range, we do not want
-- to abort, we want a warning and a runtime constraint error. Note that -- to abort, we want a warning and a runtime constraint error. Note that
...@@ -3277,9 +3257,7 @@ package body Exp_Ch4 is ...@@ -3277,9 +3257,7 @@ package body Exp_Ch4 is
------------------------- -------------------------
procedure Rewrite_Coextension (N : Node_Id) is procedure Rewrite_Coextension (N : Node_Id) is
Temp : constant Node_Id := Temp : constant Node_Id := Make_Temporary (Loc, 'C');
Make_Defining_Identifier (Loc,
New_Internal_Name ('C'));
-- Generate: -- Generate:
-- Cnn : aliased Etyp; -- Cnn : aliased Etyp;
...@@ -3432,9 +3410,7 @@ package body Exp_Ch4 is ...@@ -3432,9 +3410,7 @@ package body Exp_Ch4 is
-- and replace the allocator by Tnn'Unrestricted_Access. Tnn is -- and replace the allocator by Tnn'Unrestricted_Access. Tnn is
-- marked as requiring static allocation. -- marked as requiring static allocation.
Temp := Temp := Make_Temporary (Loc, 'T', Expression (Expression (N)));
Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
Desig := Subtype_Mark (Expression (N)); Desig := Subtype_Mark (Expression (N));
-- If context is constrained, use constrained subtype directly, -- If context is constrained, use constrained subtype directly,
...@@ -3597,7 +3573,7 @@ package body Exp_Ch4 is ...@@ -3597,7 +3573,7 @@ package body Exp_Ch4 is
if not Restriction_Active (No_Default_Initialization) then if not Restriction_Active (No_Default_Initialization) then
Init := Base_Init_Proc (T); Init := Base_Init_Proc (T);
Nod := N; Nod := N;
Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('P')); Temp := Make_Temporary (Loc, 'P');
-- Construct argument list for the initialization routine call -- Construct argument list for the initialization routine call
...@@ -3965,8 +3941,7 @@ package body Exp_Ch4 is ...@@ -3965,8 +3941,7 @@ package body Exp_Ch4 is
P_Decl := P_Decl :=
Make_Full_Type_Declaration (Loc, Make_Full_Type_Declaration (Loc,
Defining_Identifier => Defining_Identifier => Make_Temporary (Loc, 'A'),
Make_Defining_Identifier (Loc, New_Internal_Name ('A')),
Type_Definition => Type_Definition =>
Make_Access_To_Object_Definition (Loc, Make_Access_To_Object_Definition (Loc,
All_Present => True, All_Present => True,
...@@ -5882,8 +5857,7 @@ package body Exp_Ch4 is ...@@ -5882,8 +5857,7 @@ package body Exp_Ch4 is
-- En * En -- En * En
else -- Expv = 4 else -- Expv = 4
Temp := Temp := Make_Temporary (Loc, 'E', Base);
Make_Defining_Identifier (Loc, New_Internal_Name ('E'));
Insert_Actions (N, New_List ( Insert_Actions (N, New_List (
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
...@@ -6811,7 +6785,7 @@ package body Exp_Ch4 is ...@@ -6811,7 +6785,7 @@ package body Exp_Ch4 is
Name => B_J, Name => B_J,
Expression => Make_Op_Not (Loc, A_J)))); Expression => Make_Op_Not (Loc, A_J))));
Func_Name := Make_Defining_Identifier (Loc, New_Internal_Name ('N')); Func_Name := Make_Temporary (Loc, 'N');
Set_Is_Inlined (Func_Name); Set_Is_Inlined (Func_Name);
Insert_Action (N, Insert_Action (N,
...@@ -7646,7 +7620,7 @@ package body Exp_Ch4 is ...@@ -7646,7 +7620,7 @@ package body Exp_Ch4 is
Constraints => Cons)); Constraints => Cons));
end if; end if;
Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('C')); Temp := Make_Temporary (Loc, 'C');
Decl := Decl :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => Temp, Defining_Identifier => Temp,
...@@ -7808,9 +7782,7 @@ package body Exp_Ch4 is ...@@ -7808,9 +7782,7 @@ package body Exp_Ch4 is
Enable_Overflow_Check (Conv); Enable_Overflow_Check (Conv);
end if; end if;
Tnn := Tnn := Make_Temporary (Loc, 'T', Conv);
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('T'));
Insert_Actions (N, New_List ( Insert_Actions (N, New_List (
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
...@@ -8978,7 +8950,7 @@ package body Exp_Ch4 is ...@@ -8978,7 +8950,7 @@ package body Exp_Ch4 is
PtrT /= PtrT /=
Etype (Defining_Unit_Name (Associated_Node_For_Itype (PtrT))) Etype (Defining_Unit_Name (Associated_Node_For_Itype (PtrT)))
then then
Owner := Make_Defining_Identifier (Loc, New_Internal_Name ('J')); Owner := Make_Temporary (Loc, 'J');
Insert_Action (N, Insert_Action (N,
Make_Full_Type_Declaration (Loc, Make_Full_Type_Declaration (Loc,
Defining_Identifier => Owner, Defining_Identifier => Owner,
...@@ -9469,7 +9441,7 @@ package body Exp_Ch4 is ...@@ -9469,7 +9441,7 @@ package body Exp_Ch4 is
-- if ... end if; -- if ... end if;
-- end Gnnn; -- end Gnnn;
Func_Name := Make_Defining_Identifier (Loc, New_Internal_Name ('G')); Func_Name := Make_Temporary (Loc, 'G');
Func_Body := Func_Body :=
Make_Subprogram_Body (Loc, Make_Subprogram_Body (Loc,
...@@ -9597,8 +9569,7 @@ package body Exp_Ch4 is ...@@ -9597,8 +9569,7 @@ package body Exp_Ch4 is
Defining_Identifier => B, Defining_Identifier => B,
Parameter_Type => New_Reference_To (Typ, Loc))); Parameter_Type => New_Reference_To (Typ, Loc)));
Func_Name := Func_Name := Make_Temporary (Loc, 'A');
Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
Set_Is_Inlined (Func_Name); Set_Is_Inlined (Func_Name);
Func_Body := Func_Body :=
......
gcc/ada/tbuild.adb
...@@ -442,9 +442,9 @@ package body Tbuild is ...@@ -442,9 +442,9 @@ package body Tbuild is
function Make_Temporary function Make_Temporary
(Loc : Source_Ptr; (Loc : Source_Ptr;
Id : Character; Id : Character;
Related_Node : Node_Id := Empty) return Node_Id Related_Node : Node_Id := Empty) return Entity_Id
is is
Temp : constant Node_Id := Temp : constant Entity_Id :=
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
Chars => New_Internal_Name (Id)); Chars => New_Internal_Name (Id));
begin begin
......
gcc/ada/tbuild.ads
...@@ -179,11 +179,16 @@ package Tbuild is ...@@ -179,11 +179,16 @@ package Tbuild is
function Make_Temporary function Make_Temporary
(Loc : Source_Ptr; (Loc : Source_Ptr;
Id : Character; Id : Character;
Related_Node : Node_Id := Empty) return Node_Id; Related_Node : Node_Id := Empty) return Entity_Id;
-- Create a defining identifier to capture the value of an expression -- This function should be used for all cases where a temporary is
-- or aggregate, and link it to the expression that it replaces, in -- built with a name to be obtained by New_Internal_Name (here Id is
-- order to provide better CodePeer reports. The defining identifier -- the character passed as the argument to New_Internal_Name). Loc
-- name is obtained by New_Internal_Name (Id). -- is the location for the Sloc value of the resulting Entity.
--
-- Related_Node is used when the identifier is capturing the value of
-- an expression (e.g. an aggregate). It should be set whenever possible
-- to point to the expression that is being captured. This is provided
-- to get better error messages, especially from CodePeer reports.
function Make_Unsuppress_Block function Make_Unsuppress_Block
(Loc : Source_Ptr; (Loc : Source_Ptr;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment