* gcc-interface/trans.c (Identifier_to_gnu): Use boolean variable.

	(call_to_gnu): Test gigi's flag TYPE_BY_REFERENCE_P instead of calling
	front-end's predicate Is_By_Reference_Type.  Use consistent order and
	remove ??? comment.  Use original conversion in all cases, if any.
	* gcc-interface/utils.c (make_dummy_type): Minor tweak.
	(convert): Use local copy in more cases.
	<INDIRECT_REF>: Remove deactivated code.
	(unchecked_convert): Use a couple of local copies.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158216 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 55898e3..22a68c4 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2010-04-12  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/trans.c (Identifier_to_gnu): Use boolean variable.
+       (call_to_gnu): Test gigi's flag TYPE_BY_REFERENCE_P instead of calling
+       front-end's predicate Is_By_Reference_Type.  Use consistent order and
+       remove ??? comment.  Use original conversion in all cases, if any.
+       * gcc-interface/utils.c (make_dummy_type): Minor tweak.
+       (convert): Use local copy in more cases.
+       <INDIRECT_REF>: Remove deactivated code.
+       (unchecked_convert): Use a couple of local copies.
+
 2010-04-11  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/trans.c (lvalue_required_for_attribute_p): New static

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index d1606d0..3ddd61b 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -1050,21 +1050,15 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
     {
       bool constant_only = (TREE_CODE (gnu_result) == CONST_DECL
                            && !DECL_CONST_CORRESPONDING_VAR (gnu_result));
-      bool address_of_constant = (TREE_CODE (gnu_result) == CONST_DECL
-                                 && DECL_CONST_ADDRESS_P (gnu_result));
-
-      /* If there is a (corresponding) variable or this is the address of a
-        constant, we only want to return the initializer if an lvalue isn't
-        required.  Evaluate this now if we have not already done so.  */
-      if ((!constant_only || address_of_constant) && require_lvalue < 0)
-       require_lvalue
-         = lvalue_required_p (gnat_node, gnu_result_type, true,
-                              address_of_constant, Is_Aliased (gnat_temp));
-
-      /* ??? We need to unshare the initializer if the object is external
-        as such objects are not marked for unsharing if we are not at the
-        global level.  This should be fixed in add_decl_expr.  */
-      if ((constant_only && !address_of_constant) || !require_lvalue)
+
+      /* If there is a (corresponding) variable, we only want to return
+        the constant value if an lvalue is not required.  Evaluate this
+        now if we have not already done so.  */
+      if (!constant_only && require_lvalue < 0)
+       require_lvalue = lvalue_required_p (gnat_node, gnu_result_type, true,
+                                           Is_Aliased (gnat_temp));
+
+      if (constant_only || !require_lvalue)
        gnu_result = unshare_expr (DECL_INITIAL (gnu_result));
     }
 
@@ -2715,8 +2709,9 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
        {
          tree gnu_copy = gnu_name;
 
-         /* If the type is by_reference, a copy is not allowed.  */
-         if (Is_By_Reference_Type (Etype (gnat_formal)))
+         /* If the type is passed by reference, a copy is not allowed.  */
+         if (AGGREGATE_TYPE_P (gnu_formal_type)
+             && TYPE_BY_REFERENCE_P (gnu_formal_type))
            post_error
              ("misaligned actual cannot be passed by reference", gnat_actual);
 
@@ -2803,20 +2798,8 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
          = unchecked_convert (gnat_to_gnu_type (Etype (gnat_actual)),
                               gnu_actual, No_Truncation (gnat_actual));
       else
-       {
-         if (Ekind (gnat_formal) != E_Out_Parameter
-             && Do_Range_Check (gnat_actual))
-           gnu_actual = emit_range_check (gnu_actual, Etype (gnat_formal),
-                                          gnat_actual);
-
-         /* We may have suppressed a conversion to the Etype of the actual
-            since the parent is a procedure call.  So put it back here.
-            ??? We use the reverse order compared to the case above because
-            of an awkward interaction with the check.  */
-         if (TREE_CODE (gnu_actual) != SAVE_EXPR)
-           gnu_actual = convert (gnat_to_gnu_type (Etype (gnat_actual)),
-                                 gnu_actual);
-       }
+       gnu_actual
+         = convert (gnat_to_gnu_type (Etype (gnat_actual)), gnu_actual);
 
       /* Make sure that the actual is in range of the formal's type.  */
       if (Ekind (gnat_formal) != E_Out_Parameter
@@ -2824,6 +2807,10 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
        gnu_actual
          = emit_range_check (gnu_actual, Etype (gnat_formal), gnat_actual);
 
+      /* And convert it to this type.  */
+      if (TREE_CODE (gnu_actual) != SAVE_EXPR)
+       gnu_actual = convert (gnu_formal_type, gnu_actual);
+
       /* Unless this is an In parameter, we must remove any justified modular
         building from GNU_NAME to get an lvalue.  */
       if (Ekind (gnat_formal) != E_In_Parameter

diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 24bf3f7..351571f 100644 (file)
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -295,8 +295,8 @@ make_dummy_type (Entity_Id gnat_type)
   TYPE_DUMMY_P (gnu_type) = 1;
   TYPE_STUB_DECL (gnu_type)
     = create_type_stub_decl (TYPE_NAME (gnu_type), gnu_type);
-  if (Is_By_Reference_Type (gnat_type))
-    TREE_ADDRESSABLE (gnu_type) = 1;
+  if (AGGREGATE_TYPE_P (gnu_type) && Is_By_Reference_Type (gnat_type))
+    TYPE_BY_REFERENCE_P (gnu_type) = 1;
 
   SET_DUMMY_NODE (gnat_underlying, gnu_type);