===================================================================
@@ -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))
===================================================================
@@ -5208,6 +5208,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_
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_
/* 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_
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));
===================================================================
@@ -5257,30 +5257,20 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_t
/* 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: