einfo.ads, einfo.adb: New attribute Related_Expression...

2009-07-09  Ed Schonberg  <schonberg@adacore.com>

	* einfo.ads, einfo.adb: New attribute Related_Expression, used to link
	a temporary to the source expression whose value it captures.

	* exp_util.adb (Remove_Side_Effects): Set Related_Expression as needed.

From-SVN: r149406

4 files changed, 40 insertions, 1 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 82c7321..78006e5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2009-07-09  Ed Schonberg  <schonberg@adacore.com>
+
+	* einfo.ads, einfo.adb: New attribute Related_Expression, used to link
+	a temporary to the source expression whose value it captures.
+
+	* exp_util.adb (Remove_Side_Effects): Set Related_Expression as needed.
+
 2009-07-07  Manuel López-Ibáñez  <manu@gcc.gnu.org>
 
 	* gcc-interface/trans.c (gnat_gimplify_expr): Replace EXPR_LOCUS by
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 3791792..b28293a 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -205,6 +205,7 @@ package body Einfo is
    --    Protection_Object               Node23
    --    Stored_Constraint               Elist23
 
+   --    Related_Expression              Node24
    --    Spec_PPC_List                   Node24
    --    Underlying_Record_View          Node24
 
@@ -2463,6 +2464,12 @@ package body Einfo is
       return Node19 (Id);
    end Related_Array_Object;
 
+   function Related_Expression (Id : E) return N is
+   begin
+      pragma Assert (Ekind (Id) = E_Constant or else Ekind (Id) = E_Variable);
+      return Node24 (Id);
+   end Related_Expression;
+
    function Related_Instance (Id : E) return E is
    begin
       pragma Assert
@@ -4955,6 +4962,11 @@ package body Einfo is
       Set_Node19 (Id, V);
    end Set_Related_Array_Object;
 
+   procedure Set_Related_Expression (Id : E; V : N) is
+   begin
+      Set_Node24 (Id, V);
+   end Set_Related_Expression;
+
    procedure Set_Related_Instance (Id : E; V : E) is
    begin
       pragma Assert
@@ -7948,6 +7960,9 @@ package body Einfo is
          when E_Record_Type                                =>
             Write_Str ("Underlying record view");
 
+         when E_Variable | E_Constant                      =>
+            Write_Str ("Related expression");
+
          when others                                       =>
             Write_Str ("???");
       end case;
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index bebdda0..6c28ed8 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3226,6 +3226,11 @@ package Einfo is
 --       to the entity of the corresponding array object. Currently used
 --       only for type-related error messages.
 
+--    Related_Expression (Node24)
+--       Present in variables generated internally. Denotes the source
+--       expression whose elaboration created the variable declaration.
+--       Used for clearer messages from CodePeer.
+
 --    Related_Instance (Node15)
 --       Present in the wrapper packages created for subprogram instances.
 --       The internal subprogram that implements the instance is inside the
@@ -5396,6 +5401,7 @@ package Einfo is
    --    Interface_Name                      (Node21)
    --    Shared_Var_Procs_Instance           (Node22)
    --    Extra_Constrained                   (Node23)
+   --    Related_Expression                  (Node24)
    --    Debug_Renaming_Link                 (Node25)
    --    Last_Assignment                     (Node26)
    --    Has_Alignment_Clause                (Flag46)
@@ -5970,6 +5976,7 @@ package Einfo is
    function Referenced_Object                   (Id : E) return N;
    function Register_Exception_Call             (Id : E) return N;
    function Related_Array_Object                (Id : E) return E;
+   function Related_Expression                  (Id : E) return N;
    function Related_Instance                    (Id : E) return E;
    function Related_Type                        (Id : E) return E;
    function Relative_Deadline_Variable          (Id : E) return E;
@@ -6524,6 +6531,7 @@ package Einfo is
    procedure Set_Referenced_Object               (Id : E; V : N);
    procedure Set_Register_Exception_Call         (Id : E; V : N);
    procedure Set_Related_Array_Object            (Id : E; V : E);
+   procedure Set_Related_Expression              (Id : E; V : N);
    procedure Set_Related_Instance                (Id : E; V : E);
    procedure Set_Related_Type                    (Id : E; V : E);
    procedure Set_Relative_Deadline_Variable      (Id : E; V : E);
@@ -7219,6 +7227,7 @@ package Einfo is
    pragma Inline (Referenced_Object);
    pragma Inline (Register_Exception_Call);
    pragma Inline (Related_Array_Object);
+   pragma Inline (Related_Expression);
    pragma Inline (Related_Instance);
    pragma Inline (Related_Type);
    pragma Inline (Relative_Deadline_Variable);
@@ -7607,6 +7616,7 @@ package Einfo is
    pragma Inline (Set_Referenced_Object);
    pragma Inline (Set_Register_Exception_Call);
    pragma Inline (Set_Related_Array_Object);
+   pragma Inline (Set_Related_Expression);
    pragma Inline (Set_Related_Instance);
    pragma Inline (Set_Related_Type);
    pragma Inline (Set_Renamed_Entity);
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index be7c71a..af7d0aa 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -4595,6 +4595,7 @@ 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.
@@ -4612,6 +4613,7 @@ 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,6 +4655,7 @@ 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'));
@@ -4668,6 +4671,7 @@ 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.
@@ -4709,9 +4713,10 @@ package body Exp_Util is
                 Defining_Identifier => Def_Id,
                 Subtype_Mark        => New_Reference_To (Exp_Type, Loc),
                 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
@@ -4757,6 +4762,7 @@ 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;
@@ -4814,6 +4820,7 @@ 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