ada-tree.h (DECL_FORCED_BY_REF_P): New macro.

	* gcc-interface/ada-tree.h (DECL_FORCED_BY_REF_P): New macro.
	* gcc-interface/decl.c (gnat_to_gnu_param): Set it on parameters
	whose mechanism was forced to by-reference.
	* gcc-interface/trans.c (Call_to_gnu): Do not issue a warning about a
	misaligned actual parameter if it is based on a CONSTRUCTOR.  Remove
 	obsolete warning for users of Starlet.  Issue a warning if a temporary
	is make around the call for a parameter with DECL_FORCED_BY_REF_P set.
	(addressable_p): Return true for REAL_CST and ADDR_EXPR.

From-SVN: r275198

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f4c510d9fff06ebabc8d3a5dc3f63c0e7d230b9c..bb43565467d8793a0241fef78a21fbd6baba2217 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2019-08-30  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/ada-tree.h (DECL_FORCED_BY_REF_P): New macro.
+       * gcc-interface/decl.c (gnat_to_gnu_param): Set it on parameters
+       whose mechanism was forced to by-reference.
+       * gcc-interface/trans.c (Call_to_gnu): Do not issue a warning about a
+       misaligned actual parameter if it is based on a CONSTRUCTOR.  Remove
+       obsolete warning for users of Starlet.  Issue a warning if a temporary
+       is make around the call for a parameter with DECL_FORCED_BY_REF_P set.
+       (addressable_p): Return true for REAL_CST and ADDR_EXPR.
+
 2019-08-30  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/trans.c (gnat_to_gnu): Do not set the location on an

diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h
index 2029b7c1a5275cbe1c12cb350e5a427a9b96a545..acea5d157ef1c86fa564a62802f5a9f0e25fa474 100644 (file)
--- a/gcc/ada/gcc-interface/ada-tree.h
+++ b/gcc/ada/gcc-interface/ada-tree.h
@@ -482,6 +482,9 @@ do {                                                   \
    value of a function call or 'reference to a function call.  */
 #define DECL_RETURN_VALUE_P(NODE) DECL_LANG_FLAG_5 (VAR_DECL_CHECK (NODE))
 
+/* Nonzero in a PARM_DECL if its mechanism was forced to by-reference.  */
+#define DECL_FORCED_BY_REF_P(NODE) DECL_LANG_FLAG_5 (PARM_DECL_CHECK (NODE))
+
 /* In a FIELD_DECL corresponding to a discriminant, contains the
    discriminant number.  */
 #define DECL_DISCRIMINANT_NUMBER(NODE) DECL_INITIAL (FIELD_DECL_CHECK (NODE))

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 5fce2ad772d50a62cb1fae03193e8fe099704433..85a5e76724f1a5aec9dff0cd54be7dfdae0b55e6 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -5208,6 +5208,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first,
   bool ro_param = in_param && !Address_Taken (gnat_param);
   bool by_return = false, by_component_ptr = false;
   bool by_ref = false;
+  bool forced_by_ref = false;
   bool restricted_aliasing_p = false;
   location_t saved_location = input_location;
   tree gnu_param;
@@ -5235,7 +5236,11 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first,
   /* Or else, see if a Mechanism was supplied that forced this parameter
      to be passed one way or another.  */
   else if (mech == Default || mech == By_Copy || mech == By_Reference)
-    ;
+    forced_by_ref
+      = (mech == By_Reference
+        && !foreign
+        && !TYPE_IS_BY_REFERENCE_P (gnu_param_type)
+        && !Is_Aliased (gnat_param));
 
   /* Positive mechanism means by copy for sufficiently small parameters.  */
   else if (mech > 0)
@@ -5368,6 +5373,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first,
   gnu_param = create_param_decl (gnu_param_name, gnu_param_type);
   TREE_READONLY (gnu_param) = ro_param || by_ref || by_component_ptr;
   DECL_BY_REF_P (gnu_param) = by_ref;
+  DECL_FORCED_BY_REF_P (gnu_param) = forced_by_ref;
   DECL_BY_COMPONENT_PTR_P (gnu_param) = by_component_ptr;
   DECL_POINTS_TO_READONLY_P (gnu_param)
     = (ro_param && (by_ref || by_component_ptr));

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index e7064c6e72e6bd76806fd72c10b25dc3af01fd1d..4d2fa93ffcebdefbb74fa84b78ffa5b83cd227eb 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -5257,30 +5257,20 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
 
          /* Do not issue warnings for CONSTRUCTORs since this is not a copy
             but sort of an instantiation for them.  */
-         if (TREE_CODE (gnu_name) == CONSTRUCTOR)
+         if (TREE_CODE (remove_conversions (gnu_name, true)) == CONSTRUCTOR)
            ;
 
-         /* If the type is passed by reference, a copy is not allowed.  */
-         else if (TYPE_IS_BY_REFERENCE_P (gnu_formal_type))
+         /* If the formal is passed by reference, a copy is not allowed.  */
+         else if (TYPE_IS_BY_REFERENCE_P (gnu_formal_type)
+                  || Is_Aliased (gnat_formal))
            post_error ("misaligned actual cannot be passed by reference",
                        gnat_actual);
 
-         /* For users of Starlet we issue a warning because the interface
-            apparently assumes that by-ref parameters outlive the procedure
-            invocation.  The code still will not work as intended, but we
-            cannot do much better since low-level parts of the back-end
-            would allocate temporaries at will because of the misalignment
-            if we did not do so here.  */
-         else if (Is_Valued_Procedure (Entity (Name (gnat_node))))
-           {
-             post_error
-               ("?possible violation of implicit assumption", gnat_actual);
-             post_error_ne
-               ("?made by pragma Import_Valued_Procedure on &", gnat_actual,
-                Entity (Name (gnat_node)));
-             post_error_ne ("?because of misalignment of &", gnat_actual,
-                            gnat_formal);
-           }
+         /* If the mechanism was forced to by-ref, a copy is not allowed but
+            we issue only a warning because this case is not strict Ada.  */
+         else if (DECL_FORCED_BY_REF_P (gnu_formal))
+           post_error ("misaligned actual cannot be passed by reference??",
+                       gnat_actual);
 
          /* If the actual type of the object is already the nominal type,
             we have nothing to do, except if the size is self-referential
@@ -10394,6 +10384,7 @@ addressable_p (tree gnu_expr, tree gnu_type)
 
     case STRING_CST:
     case INTEGER_CST:
+    case REAL_CST:
       /* Taking the address yields a pointer to the constant pool.  */
       return true;
 
@@ -10403,6 +10394,7 @@ addressable_p (tree gnu_expr, tree gnu_type)
       return TREE_STATIC (gnu_expr) ? true : false;
 
     case NULL_EXPR:
+    case ADDR_EXPR:
     case SAVE_EXPR:
     case CALL_EXPR:
     case PLUS_EXPR: