trans.c (set_gnu_expr_location_from_node): New static function.

	* gcc-interface/trans.c (set_gnu_expr_location_from_node): New static
	function.
	(gnat_to_gnu) <N_Expression_With_Actions>: New case.
	Use set_gnu_expr_location_from_node to set location information on the
	result.

From-SVN: r160949

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ae496085d2df5c777e69a5c15d2917a0652d99ab..fde2d2588c62835768acab578c3a5c0c26ae7fb0 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2010-06-17  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/trans.c (set_gnu_expr_location_from_node): New static
+       function.
+       (gnat_to_gnu) <N_Expression_With_Actions>: New case.
+       Use set_gnu_expr_location_from_node to set location information on the
+       result.
+
 2010-06-17  Arnaud Charlet  <charlet@adacore.com>
 
        * gcc-interface/Make-lang.in: Update dependencies.
@@ -182,7 +190,8 @@
 
 2010-06-17  Robert Dewar  <dewar@adacore.com>
 
-       * exp_ch4.adb: Minor reformatting
+       * exp_ch4.adb: Minor reformatting.
+
 2010-06-17  Ed Schonberg  <schonberg@adacore.com>
 
        * sinfo.ads, sinfo.adb (Inherited_Discriminant): New flag on

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index e163d92309186011268bcc49632b0121047350e8..4546c1849499167dbc56d855629076bd45c51d3b 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -204,6 +204,7 @@ static tree extract_values (tree, tree);
 static tree pos_to_constructor (Node_Id, tree, Entity_Id);
 static tree maybe_implicit_deref (tree);
 static void set_expr_location_from_node (tree, Node_Id);
+static void set_gnu_expr_location_from_node (tree, Node_Id);
 static int lvalue_required_p (Node_Id, tree, bool, bool, bool);
 
 /* Hooks for debug info back-ends, only supported and used in a restricted set
@@ -5317,6 +5318,19 @@ gnat_to_gnu (Node_Id gnat_node)
     /* Added Nodes  */
     /****************/
 
+    case N_Expression_With_Actions:
+      gnu_result_type = get_unpadded_type (Etype (gnat_node));
+      /* This construct doesn't define a scope so we don't wrap the statement
+        list in a BIND_EXPR; however, we wrap it in a SAVE_EXPR to protect it
+        from unsharing.  */
+      gnu_result = build_stmt_group (Actions (gnat_node), false);
+      gnu_result = build1 (SAVE_EXPR, void_type_node, gnu_result);
+      TREE_SIDE_EFFECTS (gnu_result) = 1;
+      gnu_expr = gnat_to_gnu (Expression (gnat_node));
+      gnu_result
+       = build2 (COMPOUND_EXPR, TREE_TYPE (gnu_expr), gnu_result, gnu_expr);
+      break;
+
     case N_Freeze_Entity:
       start_stmt_group ();
       process_freeze_entity (gnat_node);
@@ -5536,17 +5550,11 @@ gnat_to_gnu (Node_Id gnat_node)
                                  convert (gnu_result_type,
                                           boolean_false_node));
 
-  /* Set the location information on the result if it is a real expression.
-     References can be reused for multiple GNAT nodes and they would get
-     the location information of their last use.  Note that we may have
+  /* Set the location information on the result.  Note that we may have
      no result if we tried to build a CALL_EXPR node to a procedure with
      no side-effects and optimization is enabled.  */
-  if (gnu_result
-      && EXPR_P (gnu_result)
-      && TREE_CODE (gnu_result) != NOP_EXPR
-      && !REFERENCE_CLASS_P (gnu_result)
-      && !EXPR_HAS_LOCATION (gnu_result))
-    set_expr_location_from_node (gnu_result, gnat_node);
+  if (gnu_result && EXPR_P (gnu_result))
+    set_gnu_expr_location_from_node (gnu_result, gnat_node);
 
   /* If we're supposed to return something of void_type, it means we have
      something we're elaborating for effect, so just return.  */
@@ -7450,6 +7458,37 @@ set_expr_location_from_node (tree node, Node_Id gnat_node)
 
   SET_EXPR_LOCATION (node, locus);
 }
+
+/* More elaborate version of set_expr_location_from_node to be used in more
+   general contexts, for example the result of the translation of a generic
+   GNAT node.  */
+
+static void
+set_gnu_expr_location_from_node (tree node, Node_Id gnat_node)
+{
+  /* Set the location information on the node if it is a real expression.
+     References can be reused for multiple GNAT nodes and they would get
+     the location information of their last use.  Also make sure not to
+     overwrite an existing location as it is probably more precise.  */
+
+  switch (TREE_CODE (node))
+    {
+    CASE_CONVERT:
+    case NON_LVALUE_EXPR:
+      break;
+
+    case COMPOUND_EXPR:
+      if (EXPR_P (TREE_OPERAND (node, 1)))
+       set_gnu_expr_location_from_node (TREE_OPERAND (node, 1), gnat_node);
+
+      /* ... fall through ... */
+
+    default:
+      if (!REFERENCE_CLASS_P (node) && !EXPR_HAS_LOCATION (node))
+       set_expr_location_from_node (node, gnat_node);
+      break;
+    }
+}
 \f
 /* Return a colon-separated list of encodings contained in encoded Ada
    name.  */