diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 764df662006..5d888c03c3d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2009-07-13 Ed Schonberg + + * exp_ch7.adb, exp_util.adb, tbuild.adb, tbuild.ads, exp_ch4.adb, + exp_aggr.adb (Make_Temporary): Utility to create a defining identifier + and link it to the expression whose value it captures. + 2009-07-13 Robert Dewar * output.adb: Minor comment addition for last change diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 17862fe778e..11174614df1 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -2996,13 +2996,11 @@ package body Exp_Aggr is -- will be used to capture the aggregate assignments. TmpE : constant Entity_Id := - Make_Defining_Identifier (Loc, - New_Internal_Name ('A')); + Make_Temporary (Loc, New_Internal_Name ('A'), N); TmpD : constant Node_Id := Make_Object_Declaration (Loc, - Defining_Identifier => - TmpE, + Defining_Identifier => TmpE, Object_Definition => New_Reference_To (SubE, Loc)); @@ -3588,7 +3586,7 @@ package body Exp_Aggr is Rewrite (Parent (N), Make_Null_Statement (Loc)); else - Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('A')); + Temp := Make_Temporary (Loc, New_Internal_Name ('A'), N); -- If the type inherits unknown discriminants, use the view with -- known discriminants if available. @@ -5203,7 +5201,7 @@ package body Exp_Aggr is else Maybe_In_Place_OK := False; - Tmp := Make_Defining_Identifier (Loc, New_Internal_Name ('A')); + Tmp := Make_Temporary (Loc, New_Internal_Name ('A'), N); Tmp_Decl := Make_Object_Declaration (Loc, diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 178f1644884..f8f2caa79b3 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -4043,7 +4043,7 @@ package body Exp_Ch4 is -- and replace the conditional expresion by a reference to Cnn.all ??? if Present (Then_Actions (N)) or else Present (Else_Actions (N)) then - Cnn := Make_Defining_Identifier (Loc, New_Internal_Name ('C')); + Cnn := Make_Temporary (Loc, New_Internal_Name ('C'), N); New_If := Make_Implicit_If_Statement (N, @@ -4092,10 +4092,6 @@ package body Exp_Ch4 is Insert_Action (N, New_If); Analyze_And_Resolve (N, Typ); - - -- Link temporary to original expression, for CodePeer - - Set_Related_Expression (Cnn, Original_Node (N)); end if; end Expand_N_Conditional_Expression; diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 6b78f05cd0a..9dd58574214 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -3552,14 +3552,10 @@ package body Exp_Ch7 is procedure Wrap_Transient_Expression (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); E : constant Entity_Id := - Make_Defining_Identifier (Loc, New_Internal_Name ('E')); + Make_Temporary (Loc, New_Internal_Name ('E'), N); Etyp : constant Entity_Id := Etype (N); begin - -- Indicate the origin of the temporary, for better reports - -- in CodePeer. - - Set_Related_Expression (E, N); Insert_Actions (N, New_List ( Make_Object_Declaration (Loc, Defining_Identifier => E, diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index e8a1fdd3dbc..bd7f90cbe39 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -4588,7 +4588,7 @@ package body Exp_Util is or else Nkind (Exp) in N_Op or else (not Name_Req and then Is_Volatile_Reference (Exp))) then - Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R')); + Def_Id := Make_Temporary (Loc, New_Internal_Name ('R'), Exp); Set_Etype (Def_Id, Exp_Type); Res := New_Reference_To (Def_Id, Loc); @@ -4601,14 +4601,12 @@ package body Exp_Util is Set_Assignment_OK (E); Insert_Action (Exp, E); - Set_Related_Expression (Def_Id, Exp); -- If the expression has the form v.all then we can just capture -- the pointer, and then do an explicit dereference on the result. elsif Nkind (Exp) = N_Explicit_Dereference then - Def_Id := - Make_Defining_Identifier (Loc, New_Internal_Name ('R')); + Def_Id := Make_Temporary (Loc, New_Internal_Name ('R'), Exp); Res := Make_Explicit_Dereference (Loc, New_Reference_To (Def_Id, Loc)); @@ -4619,7 +4617,6 @@ package body Exp_Util is New_Reference_To (Etype (Prefix (Exp)), Loc), Constant_Present => True, Expression => Relocate_Node (Prefix (Exp)))); - Set_Related_Expression (Def_Id, Exp); -- Similar processing for an unchecked conversion of an expression -- of the form v.all, where we want the same kind of treatment. @@ -4653,7 +4650,7 @@ package body Exp_Util is -- Use a renaming to capture the expression, rather than create -- a controlled temporary. - Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R')); + Def_Id := Make_Temporary (Loc, New_Internal_Name ('R'), Exp); Res := New_Reference_To (Def_Id, Loc); Insert_Action (Exp, @@ -4661,10 +4658,9 @@ package body Exp_Util is Defining_Identifier => Def_Id, Subtype_Mark => New_Reference_To (Exp_Type, Loc), Name => Relocate_Node (Exp))); - Set_Related_Expression (Def_Id, Exp); else - Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R')); + Def_Id := Make_Temporary (Loc, New_Internal_Name ('R'), Exp); Set_Etype (Def_Id, Exp_Type); Res := New_Reference_To (Def_Id, Loc); @@ -4677,7 +4673,6 @@ package body Exp_Util is Set_Assignment_OK (E); Insert_Action (Exp, E); - Set_Related_Expression (Def_Id, Exp); end if; -- For expressions that denote objects, we can use a renaming scheme. @@ -4688,7 +4683,7 @@ package body Exp_Util is and then Nkind (Exp) /= N_Function_Call and then (Name_Req or else not Is_Volatile_Reference (Exp)) then - Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R')); + Def_Id := Make_Temporary (Loc, New_Internal_Name ('R'), Exp); if Nkind (Exp) = N_Selected_Component and then Nkind (Prefix (Exp)) = N_Function_Call @@ -4721,8 +4716,6 @@ package body Exp_Util is Name => Relocate_Node (Exp))); end if; - Set_Related_Expression (Def_Id, Exp); - -- If this is a packed reference, or a selected component with a -- non-standard representation, a reference to the temporary will -- be replaced by a copy of the original expression (see @@ -4758,8 +4751,7 @@ package body Exp_Util is then declare Obj : constant Entity_Id := - Make_Defining_Identifier (Loc, - Chars => New_Internal_Name ('F')); + Make_Temporary (Loc, New_Internal_Name ('F'), Exp); Decl : Node_Id; begin @@ -4770,7 +4762,6 @@ package body Exp_Util is Expression => Relocate_Node (Exp)); Insert_Action (Exp, Decl); Set_Etype (Obj, Exp_Type); - Set_Related_Expression (Obj, Exp); Rewrite (Exp, New_Occurrence_Of (Obj, Loc)); return; end; @@ -4790,7 +4781,7 @@ package body Exp_Util is E := Exp; Insert_Action (Exp, Ptr_Typ_Decl); - Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R')); + Def_Id := Make_Temporary (Loc, New_Internal_Name ('R'), Exp); Set_Etype (Def_Id, Exp_Type); Res := @@ -4828,7 +4819,6 @@ package body Exp_Util is Defining_Identifier => Def_Id, Object_Definition => New_Reference_To (Ref_Type, Loc), Expression => New_Exp)); - Set_Related_Expression (Def_Id, Exp); end if; -- Preserve the Assignment_OK flag in all copies, since at least diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb index 395a7137659..be882055af4 100644 --- a/gcc/ada/tbuild.adb +++ b/gcc/ada/tbuild.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -436,6 +436,18 @@ package body Tbuild is Strval => End_String); end Make_String_Literal; + function Make_Temporary + (Loc : Source_Ptr; + Id : Name_Id; + Related_Node : Node_Id := Empty) return Node_Id + is + Temp : Node_Id; + begin + Temp := Make_Defining_Identifier (Loc, Id); + Set_Related_Expression (Temp, Related_Node); + return Temp; + end Make_Temporary; + --------------------------- -- Make_Unsuppress_Block -- --------------------------- diff --git a/gcc/ada/tbuild.ads b/gcc/ada/tbuild.ads index efa8960516f..f12b616c93a 100644 --- a/gcc/ada/tbuild.ads +++ b/gcc/ada/tbuild.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -175,6 +175,14 @@ package Tbuild is -- A convenient form of Make_String_Literal, where the string value -- is given as a normal string instead of a String_Id value. + function Make_Temporary + (Loc : Source_Ptr; + Id : Name_Id; + 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. + function Make_Unsuppress_Block (Loc : Source_Ptr; Check : Name_Id;