diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-06-17 10:07:53 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-06-17 10:07:53 +0000 |
commit | 46eb69332c219e14627045d980a4f477b8d99390 (patch) | |
tree | 78b8c08b9aee1c03704dc2114f549be155153994 /gcc | |
parent | 67278d605ddd4afb9b6225ebfa8ddc51688e2f97 (diff) | |
download | gcc-46eb69332c219e14627045d980a4f477b8d99390.tar.gz |
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
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160893 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 9 | ||||
-rw-r--r-- | gcc/ada/checks.adb | 12 | ||||
-rw-r--r-- | gcc/ada/exp_aggr.adb | 32 | ||||
-rw-r--r-- | gcc/ada/exp_atag.adb | 12 | ||||
-rw-r--r-- | gcc/ada/exp_attr.adb | 64 | ||||
-rw-r--r-- | gcc/ada/exp_ch11.adb | 12 | ||||
-rw-r--r-- | gcc/ada/exp_ch3.adb | 77 | ||||
-rw-r--r-- | gcc/ada/exp_ch4.adb | 83 | ||||
-rw-r--r-- | gcc/ada/tbuild.adb | 4 | ||||
-rw-r--r-- | gcc/ada/tbuild.ads | 15 |
10 files changed, 122 insertions, 198 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 33e1f43d3ce..66ef2895f22 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,14 @@ 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_warn.adb, sem_eval.adb: Minor reformatting. Use Ekind_In. (Set_Slice_Subtype): Explicitly freeze the slice's itype at the point diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index a193c299861..199d37241b5 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -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 ( diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index dc6c8bb90d0..a2c54911bb6 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -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, diff --git a/gcc/ada/exp_atag.adb b/gcc/ada/exp_atag.adb index d5cdf0b79b7..23a9202c372 100644 --- a/gcc/ada/exp_atag.adb +++ b/gcc/ada/exp_atag.adb @@ -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: diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 7f7e1d1cc82..673ecfd4800 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -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, diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 3978e940146..0c54478c99d 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -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)); diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index e36c8dcf24f..5272f06d338 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -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_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')); + 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 + 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), diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 6846b75c64d..99e8fc064e5 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -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 := diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb index 3da3c611198..133613d9870 100644 --- a/gcc/ada/tbuild.adb +++ b/gcc/ada/tbuild.adb @@ -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 diff --git a/gcc/ada/tbuild.ads b/gcc/ada/tbuild.ads index f6b02ccbb09..d968640c7d6 100644 --- a/gcc/ada/tbuild.ads +++ b/gcc/ada/tbuild.ads @@ -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; |