mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-19 11:00:48 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Robert Dewar 2010-06-17 10:07:53 +00:00 committed by Arnaud Charlet
parent 8a95f4e867
commit 191fcb3a9f
10 changed files with 121 additions and 197 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/ada/ChangeLog
View File

@ -1,3 +1,12 @@
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,

12
gcc/ada/checks.adb
View File

@ -1584,9 +1584,7 @@ package body Checks is
pragma Assert (Target_Base /= Target_Typ);
Temp : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('T'));
Temp : constant Entity_Id := Make_Temporary (Loc, 'T', Par);
begin
Apply_Float_Conversion_Check (Ck_Node, Target_Base);
@ -4707,9 +4705,7 @@ package body Checks is
-- Then the conversion itself is replaced by an occurrence of Tnn
declare
Tnn : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('T'));
Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', N);
begin
Insert_Actions (N, New_List (
@ -4860,9 +4856,7 @@ package body Checks is
-- the value is non-negative
declare
Tnn : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('T'));
Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', N);
begin
Insert_Actions (N, New_List (

32
gcc/ada/exp_aggr.adb
View File

@ -1347,7 +1347,7 @@ package body Exp_Aggr is
-- 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
-- for the bound to convert to the index base, but we don't need
@ -1455,7 +1455,7 @@ package body Exp_Aggr is
-- 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 :=
Make_Object_Declaration
(Loc,
@ -3008,9 +3008,7 @@ package body Exp_Aggr is
-- the corresponding aggregate.
declare
SubE : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('T'));
SubE : constant Entity_Id := Make_Temporary (Loc, 'T');
SubD : constant Node_Id :=
Make_Subtype_Declaration (Loc,
@ -4139,7 +4137,7 @@ package body Exp_Aggr is
procedure Build_Constrained_Type (Positional : Boolean) is
Loc : constant Source_Ptr := Sloc (N);
Agg_Type : Entity_Id;
Agg_Type : constant Entity_Id := Make_Temporary (Loc, 'A');
Comp : Node_Id;
Decl : Node_Id;
Typ : constant Entity_Id := Etype (N);
@ -4148,10 +4146,6 @@ package body Exp_Aggr is
Sub_Agg : Node_Id;
begin
Agg_Type :=
Make_Defining_Identifier (
Loc, New_Internal_Name ('A'));
-- If the aggregate is purely positional, all its subaggregates
-- have the same size. We collect the dimensions from the first
-- subaggregate at each level.
@ -4169,19 +4163,16 @@ package body Exp_Aggr is
Next (Comp);
end loop;
Append (
Append_To (Indices,
Make_Range (Loc,
Low_Bound => Make_Integer_Literal (Loc, 1),
High_Bound =>
Make_Integer_Literal (Loc, Num)),
Indices);
Low_Bound => Make_Integer_Literal (Loc, 1),
High_Bound => Make_Integer_Literal (Loc, Num)));
end loop;
else
-- We know the aggregate type is unconstrained and the aggregate
-- is not processable by the back end, therefore not necessarily
-- positional. Retrieve each dimension bounds (computed earlier).
-- earlier.
for D in 1 .. Number_Dimensions (Typ) loop
Append (
@ -5693,9 +5684,7 @@ package body Exp_Aggr is
Decl :=
Make_Subtype_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc,
New_Internal_Name ('T')),
Defining_Identifier => Make_Temporary (Loc, 'T'),
Subtype_Indication =>
Make_Subtype_Indication (Loc,
Subtype_Mark =>
@ -6384,9 +6373,8 @@ package body Exp_Aggr is
and then Nkind (First (Choices (First (Component_Associations (N)))))
= N_Others_Choice
then
Expr :=
Expression (First (Component_Associations (N)));
L_J := Make_Defining_Identifier (Loc, New_Internal_Name ('J'));
Expr := Expression (First (Component_Associations (N)));
L_J := Make_Temporary (Loc, 'J');
L_Iter :=
Make_Iteration_Scheme (Loc,

12
gcc/ada/exp_atag.adb
View File

@ -150,14 +150,10 @@ package body Exp_Atag is
Related_Nod : Node_Id;
New_Node : out Node_Id)
is
Tag_Addr : constant Entity_Id := Make_Defining_Identifier (Loc,
New_Internal_Name ('D'));
Obj_TSD : constant Entity_Id := Make_Defining_Identifier (Loc,
New_Internal_Name ('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'));
Tag_Addr : constant Entity_Id := Make_Temporary (Loc, 'D', Obj_Tag_Node);
Obj_TSD : constant Entity_Id := Make_Temporary (Loc, 'D');
Typ_TSD : constant Entity_Id := Make_Temporary (Loc, 'D');
Index : constant Entity_Id := Make_Temporary (Loc, 'D');
begin
-- Generate:

64
gcc/ada/exp_attr.adb
View File

@ -530,9 +530,7 @@ package body Exp_Attr is
and then Is_Written
then
declare
Temp : constant Entity_Id :=
Make_Defining_Identifier
(Loc, New_Internal_Name ('V'));
Temp : constant Entity_Id := Make_Temporary (Loc, 'V');
Decl : Node_Id;
Assn : Node_Id;
@ -1263,8 +1261,7 @@ package body Exp_Attr is
-- returned is a copy of the library string in gnatvsn.ads.
when Attribute_Body_Version | Attribute_Version => Version : declare
E : constant Entity_Id :=
Make_Defining_Identifier (Loc, New_Internal_Name ('V'));
E : constant Entity_Id := Make_Temporary (Loc, 'V');
Pent : Entity_Id;
S : String_Id;
@ -1777,9 +1774,7 @@ package body Exp_Attr is
Attribute_Elab_Spec =>
Elab_Body : declare
Ent : constant Entity_Id :=
Make_Defining_Identifier (Loc,
New_Internal_Name ('E'));
Ent : constant Entity_Id := Make_Temporary (Loc, 'E');
Str : String_Id;
Lang : Node_Id;
@ -2389,13 +2384,14 @@ package body Exp_Attr is
Rtyp : constant Entity_Id := Root_Type (P_Type);
Dnn : Entity_Id;
Decl : Node_Id;
Expr : Node_Id;
begin
-- Read the internal tag (RM 13.13.2(34)) and use it to
-- initialize a dummy tag object:
-- Dnn : Ada.Tags.Tag
-- := Descendant_Tag (String'Input (Strm), P_Type);
-- Dnn : Ada.Tags.Tag :=
-- Descendant_Tag (String'Input (Strm), P_Type);
-- This dummy object is used only to provide a controlling
-- argument for the eventual _Input call. Descendant_Tag is
@ -2406,30 +2402,28 @@ package body Exp_Attr is
-- required for Ada 2005 because tagged types can be
-- extended in nested scopes (AI-344).
Dnn :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('D'));
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)));
Dnn := Make_Temporary (Loc, 'D', Expr);
Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Dnn,
Object_Definition =>
Object_Definition =>
New_Occurrence_Of (RTE (RE_Tag), Loc),
Expression =>
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))));
Expression => Expr);
Insert_Action (N, Decl);
@ -2440,8 +2434,9 @@ package body Exp_Attr is
-- tagged object).
Fname := Find_Prim_Op (Rtyp, TSS_Stream_Input);
Cntrl := Unchecked_Convert_To (P_Type,
New_Occurrence_Of (Dnn, Loc));
Cntrl :=
Unchecked_Convert_To (P_Type,
New_Occurrence_Of (Dnn, Loc));
Set_Etype (Cntrl, P_Type);
Set_Parent (Cntrl, N);
end;
@ -2987,9 +2982,7 @@ package body Exp_Attr is
---------
when Attribute_Old => Old : declare
Tnn : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('T'));
Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', Pref);
Subp : Node_Id;
Asn_Stm : Node_Id;
@ -4552,8 +4545,7 @@ package body Exp_Attr is
-----------------
when Attribute_UET_Address => UET_Address : declare
Ent : constant Entity_Id :=
Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
Ent : constant Entity_Id := Make_Temporary (Loc, 'T');
begin
Insert_Action (N,

12
gcc/ada/exp_ch11.adb
View File

@ -469,9 +469,7 @@ package body Exp_Ch11 is
Local_Expansion_Required := True;
declare
L : constant Entity_Id :=
Make_Defining_Identifier (Sloc (H),
Chars => New_Internal_Name ('L'));
L : constant Entity_Id := Make_Temporary (Sloc (H), 'L');
begin
Set_Exception_Label (H, L);
Add_Label_Declaration (L);
@ -646,9 +644,7 @@ package body Exp_Ch11 is
declare
-- L3 is the label to exit the HSS
L3_Dent : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('L'));
L3_Dent : constant Entity_Id := Make_Temporary (Loc, 'L');
Labl_L3 : constant Node_Id :=
Make_Label (Loc,
@ -1560,6 +1556,8 @@ package body Exp_Ch11 is
-- mechanism. However we need to keep the expansion for "raise;"
-- 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
return;
end if;
@ -1686,7 +1684,7 @@ package body Exp_Ch11 is
-- be referencing this entity by normal visibility methods.
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_Ekind (E, E_Variable);
Set_Etype (E, RTE (RE_Exception_Occurrence));

75
gcc/ada/exp_ch3.adb
View File

@ -504,7 +504,7 @@ package body Exp_Ch3 is
-- And insert this declaration into the tree. The type of the
-- 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),
Make_Subtype_Declaration (Loc,
@ -2115,10 +2115,7 @@ package body Exp_Ch3 is
Spec_Node : Node_Id;
begin
Func_Id :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('F'));
Func_Id := Make_Temporary (Loc, 'F');
Set_DT_Offset_To_Top_Func (Iface_Comp, Func_Id);
-- Generate
@ -2246,9 +2243,7 @@ package body Exp_Ch3 is
if Is_Tagged_Type (Rec_Type)
and then not Is_CPP_Class (Rec_Type)
then
Set_Tag :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('P'));
Set_Tag := Make_Temporary (Loc, 'P');
Append_To (Parameters,
Make_Parameter_Specification (Loc,
@ -3404,37 +3399,21 @@ package body Exp_Ch3 is
Loc : constant Source_Ptr := Sloc (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');
Left_Lo : constant Entity_Id := Make_Temporary (Loc, 'L');
Left_Hi : constant Entity_Id := Make_Temporary (Loc, 'L');
Right_Lo : constant Entity_Id := Make_Temporary (Loc, 'R');
Right_Hi : constant Entity_Id := Make_Temporary (Loc, 'R');
Rev : constant Entity_Id := Make_Temporary (Loc, 'D');
-- Formal parameters of procedure
Larray : constant Entity_Id :=
Make_Defining_Identifier
(Loc, Chars => New_Internal_Name ('A'));
Rarray : constant Entity_Id :=
Make_Defining_Identifier
(Loc, Chars => New_Internal_Name ('R'));
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 :=
Make_Defining_Identifier (Loc,
Chars => Make_TSS_Name (Typ, TSS_Slice_Assign));
Lnn : constant Entity_Id :=
Make_Defining_Identifier (Loc, New_Internal_Name ('L'));
Rnn : constant Entity_Id :=
Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
Lnn : constant Entity_Id := Make_Temporary (Loc, 'L');
Rnn : constant Entity_Id := Make_Temporary (Loc, 'R');
-- Subscripts for left and right sides
Decls : List_Id;
@ -4620,8 +4599,7 @@ package body Exp_Ch3 is
Decl_1 :=
Make_Object_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc,
New_Internal_Name ('D')),
Make_Temporary (Loc, 'D', Expr_N),
Object_Definition =>
New_Occurrence_Of (Expr_Typ, Loc),
Expression =>
@ -4633,12 +4611,9 @@ package body Exp_Ch3 is
Decl_2 :=
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc,
New_Internal_Name ('D')),
Subtype_Mark =>
New_Occurrence_Of (Typ, Loc),
Name =>
Defining_Identifier => Make_Temporary (Loc, 'D'),
Subtype_Mark => New_Occurrence_Of (Typ, Loc),
Name =>
Unchecked_Convert_To (Typ,
Make_Selected_Component (Loc,
Prefix =>
@ -4682,23 +4657,19 @@ package body Exp_Ch3 is
Decl_1 :=
Make_Object_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc,
New_Internal_Name ('D')),
Object_Definition =>
Make_Temporary (Loc, 'D', New_Expr),
Object_Definition =>
New_Occurrence_Of
(Etype (Object_Definition (N)), Loc),
Expression =>
Expression =>
Unchecked_Convert_To
(Etype (Object_Definition (N)), New_Expr));
Decl_2 :=
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc,
New_Internal_Name ('D')),
Subtype_Mark =>
New_Occurrence_Of (Typ, Loc),
Name =>
Defining_Identifier => Make_Temporary (Loc, 'D'),
Subtype_Mark => New_Occurrence_Of (Typ, Loc),
Name =>
Unchecked_Convert_To (Typ,
Make_Explicit_Dereference (Loc,
Unchecked_Convert_To (RTE (RE_Tag_Ptr),

83
gcc/ada/exp_ch4.adb
View File

@ -595,7 +595,7 @@ package body Exp_Ch4 is
Set_Analyzed (Node);
Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
Temp := Make_Temporary (Loc, 'P', Node);
Insert_Action (N,
Make_Object_Declaration (Loc,
@ -664,8 +664,7 @@ package body Exp_Ch4 is
Remove_Side_Effects (Exp);
end if;
Temp :=
Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
Temp := Make_Temporary (Loc, 'P');
-- For a class wide allocation generate the following code:
@ -755,9 +754,7 @@ package body Exp_Ch4 is
else
declare
Def_Id : constant Entity_Id :=
Make_Defining_Identifier (Loc,
New_Internal_Name ('T'));
Def_Id : constant Entity_Id := Make_Temporary (Loc, 'T');
New_Decl : Node_Id;
begin
@ -834,8 +831,7 @@ package body Exp_Ch4 is
New_Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Make_Defining_Identifier (Loc,
New_Internal_Name ('P')),
Defining_Identifier => Make_Temporary (Loc, 'P'),
Object_Definition => New_Reference_To (PtrT, Loc),
Expression => Unchecked_Convert_To (PtrT,
New_Reference_To (Temp, Loc)));
@ -916,16 +912,13 @@ package body Exp_Ch4 is
if Is_RTE (Apool, RE_SS_Pool) then
declare
F : constant Entity_Id :=
Make_Defining_Identifier (Loc,
New_Internal_Name ('F'));
F : constant Entity_Id := Make_Temporary (Loc, 'F');
begin
Insert_Action (N,
Make_Object_Declaration (Loc,
Defining_Identifier => F,
Object_Definition => New_Reference_To (RTE
(RE_Finalizable_Ptr), Loc)));
Object_Definition =>
New_Reference_To (RTE (RE_Finalizable_Ptr), Loc)));
Flist := New_Reference_To (F, Loc);
Attach := Make_Integer_Literal (Loc, 1);
end;
@ -991,8 +984,7 @@ package body Exp_Ch4 is
end if;
elsif Aggr_In_Place then
Temp :=
Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
Temp := Make_Temporary (Loc, 'P');
Tmp_Node :=
Make_Object_Declaration (Loc,
Defining_Identifier => Temp,
@ -1076,9 +1068,7 @@ package body Exp_Ch4 is
and then Is_Packed (T)
then
declare
ConstrT : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('A'));
ConstrT : constant Entity_Id := Make_Temporary (Loc, 'A');
Internal_Exp : constant Node_Id := Relocate_Node (Exp);
begin
Insert_Action (Exp,
@ -1598,8 +1588,7 @@ package body Exp_Ch4 is
-- constrained types, then we can use the same index for both
-- of the arrays.
An : constant Entity_Id := Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('A'));
An : constant Entity_Id := Make_Temporary (Loc, 'A');
Bn : Entity_Id;
Index_T : Entity_Id;
@ -1616,9 +1605,7 @@ package body Exp_Ch4 is
Index_T := Base_Type (Etype (Index));
if Need_Separate_Indexes then
Bn :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('B'));
Bn := Make_Temporary (Loc, 'B');
else
Bn := An;
end if;
@ -1805,7 +1792,7 @@ package body Exp_Ch4 is
Defining_Identifier => B,
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
@ -2625,9 +2612,7 @@ package body Exp_Ch4 is
Operands (NN) := Opnd;
Is_Fixed_Length (NN) := False;
Var_Length (NN) :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('L'));
Var_Length (NN) := Make_Temporary (Loc, 'L');
Append_To (Actions,
Make_Object_Declaration (Loc,
@ -2674,9 +2659,7 @@ package body Exp_Ch4 is
-- create an entity initialized to this length.
else
Ent :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('L'));
Ent := Make_Temporary (Loc, 'L');
if Is_Fixed_Length (NN) then
Clen := Make_Integer_Literal (Loc, Fixed_Length (NN));
@ -2794,8 +2777,7 @@ package body Exp_Ch4 is
end Get_Known_Bound;
begin
Ent :=
Make_Defining_Identifier (Loc, Chars => New_Internal_Name ('L'));
Ent := Make_Temporary (Loc, 'L');
Append_To (Actions,
Make_Object_Declaration (Loc,
@ -2851,9 +2833,7 @@ package body Exp_Ch4 is
-- Now we construct an array object with appropriate bounds
Ent :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('S'));
Ent := Make_Temporary (Loc, 'S');
-- 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
@ -3277,9 +3257,7 @@ package body Exp_Ch4 is
-------------------------
procedure Rewrite_Coextension (N : Node_Id) is
Temp : constant Node_Id :=
Make_Defining_Identifier (Loc,
New_Internal_Name ('C'));
Temp : constant Node_Id := Make_Temporary (Loc, 'C');
-- Generate:
-- Cnn : aliased Etyp;
@ -3432,9 +3410,7 @@ package body Exp_Ch4 is
-- and replace the allocator by Tnn'Unrestricted_Access. Tnn is
-- marked as requiring static allocation.
Temp :=
Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
Temp := Make_Temporary (Loc, 'T', Expression (Expression (N)));
Desig := Subtype_Mark (Expression (N));
-- If context is constrained, use constrained subtype directly,
@ -3597,7 +3573,7 @@ package body Exp_Ch4 is
if not Restriction_Active (No_Default_Initialization) then
Init := Base_Init_Proc (T);
Nod := N;
Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
Temp := Make_Temporary (Loc, 'P');
-- Construct argument list for the initialization routine call
@ -3965,8 +3941,7 @@ package body Exp_Ch4 is
P_Decl :=
Make_Full_Type_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, New_Internal_Name ('A')),
Defining_Identifier => Make_Temporary (Loc, 'A'),
Type_Definition =>
Make_Access_To_Object_Definition (Loc,
All_Present => True,
@ -5882,8 +5857,7 @@ package body Exp_Ch4 is
-- En * En
else -- Expv = 4
Temp :=
Make_Defining_Identifier (Loc, New_Internal_Name ('E'));
Temp := Make_Temporary (Loc, 'E', Base);
Insert_Actions (N, New_List (
Make_Object_Declaration (Loc,
@ -6811,7 +6785,7 @@ package body Exp_Ch4 is
Name => B_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);
Insert_Action (N,
@ -7646,7 +7620,7 @@ package body Exp_Ch4 is
Constraints => Cons));
end if;
Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('C'));
Temp := Make_Temporary (Loc, 'C');
Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Temp,
@ -7808,9 +7782,7 @@ package body Exp_Ch4 is
Enable_Overflow_Check (Conv);
end if;
Tnn :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('T'));
Tnn := Make_Temporary (Loc, 'T', Conv);
Insert_Actions (N, New_List (
Make_Object_Declaration (Loc,
@ -8978,7 +8950,7 @@ package body Exp_Ch4 is
PtrT /=
Etype (Defining_Unit_Name (Associated_Node_For_Itype (PtrT)))
then
Owner := Make_Defining_Identifier (Loc, New_Internal_Name ('J'));
Owner := Make_Temporary (Loc, 'J');
Insert_Action (N,
Make_Full_Type_Declaration (Loc,
Defining_Identifier => Owner,
@ -9469,7 +9441,7 @@ package body Exp_Ch4 is
-- if ... end if;
-- end Gnnn;
Func_Name := Make_Defining_Identifier (Loc, New_Internal_Name ('G'));
Func_Name := Make_Temporary (Loc, 'G');
Func_Body :=
Make_Subprogram_Body (Loc,
@ -9597,8 +9569,7 @@ package body Exp_Ch4 is
Defining_Identifier => B,
Parameter_Type => New_Reference_To (Typ, Loc)));
Func_Name :=
Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
Func_Name := Make_Temporary (Loc, 'A');
Set_Is_Inlined (Func_Name);
Func_Body :=

4
gcc/ada/tbuild.adb
View File

@ -442,9 +442,9 @@ package body Tbuild is
function Make_Temporary
(Loc : Source_Ptr;
Id : Character;
Related_Node : Node_Id := Empty) return Node_Id
Related_Node : Node_Id := Empty) return Entity_Id
is
Temp : constant Node_Id :=
Temp : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name (Id));
begin

15
gcc/ada/tbuild.ads
View File

@ -179,11 +179,16 @@ package Tbuild is
function Make_Temporary
(Loc : Source_Ptr;
Id : Character;
Related_Node : Node_Id := Empty) return Node_Id;
-- Create a defining identifier to capture the value of an expression
-- or aggregate, and link it to the expression that it replaces, in
-- order to provide better CodePeer reports. The defining identifier
-- name is obtained by New_Internal_Name (Id).
Related_Node : Node_Id := Empty) return Entity_Id;
-- This function should be used for all cases where a temporary is
-- built with a name to be obtained by New_Internal_Name (here Id is
-- the character passed as the argument to New_Internal_Name). Loc
-- 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
(Loc : Source_Ptr;