gigi.h (gnat_stabilize_reference): Adjust.

	* gcc-interface/gigi.h (gnat_stabilize_reference): Adjust.
	(rewrite_fn): Remove third parameter.
	(type_is_padding_self_referential): New inline predicate.
	(return_type_with_variable_size_p): Likewise.
	* gcc-interface/decl.c (allocatable_size_p): More around.
	(cannot_be_superflat_p): Rename into...
	(cannot_be_superflat ): ...this.
	(initial_value_needs_conversion): New predicate.
	(gnat_to_gnu_entity): Invoke type_is_padding_self_referential,
	initial_value_needs_conversion and adjust to above renaming.
	For a renaming, force the materialization if the inner expression
	is compound.  Adjust calls to elaborate_reference and build a
	compound expression if needed.
	(struct er_dat): Add N field.
	(elaborate_reference_1): Remove N parameter and adjust.
	(elaborate_reference): Add INIT parameter and pass it in the call to
	gnat_rewrite_reference.  Adjust initial expression.
	* gcc-interface/trans.c (Call_to_gnu): Treat renamings the same way as
	regular object declarations when it comes to creating a temporary.
	Adjust call to gnat_stabilize_reference and build a compound expression
 	if needed.  Invoke return_type_with_variable_size_p.
	(gnat_to_gnu): Invoke type_is_padding_self_referential.  In case #4,
	return a call to a function unmodified if it returns with variable size
 	and is also the initial expression in an object declaration.
	* gcc-interface/utils2.c (build_binary_op) <INIT_EXPR>: Use the RHS'
	type if it is a call to a function that returns with variable size.
	(build_unary_op): Invoke type_is_padding_self_referential.
	(gnat_stabilize_reference_1): Remove N parameter and adjust.
	(gnat_stabilize_reference): Add INIT parameter and pass it in the call
	to gnat_rewrite_reference.
	(gnat_rewrite_reference):  Remove N, add INIT parameter and adjust.
	<COMPOUND_EXPR>: New case.

From-SVN: r223834

gcc/ada/ChangeLog

+2015-05-28  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/gigi.h (gnat_stabilize_reference): Adjust.
+	(rewrite_fn): Remove third parameter.
+	(type_is_padding_self_referential): New inline predicate.
+	(return_type_with_variable_size_p): Likewise.
+	* gcc-interface/decl.c (allocatable_size_p): More around.
+	(cannot_be_superflat_p): Rename into...
+	(cannot_be_superflat ): ...this.
+	(initial_value_needs_conversion): New predicate.
+	(gnat_to_gnu_entity): Invoke type_is_padding_self_referential,
+	initial_value_needs_conversion and adjust to above renaming.
+	For a renaming, force the materialization if the inner expression
+	is compound.  Adjust calls to elaborate_reference and build a
+	compound expression if needed.
+	(struct er_dat): Add N field.
+	(elaborate_reference_1): Remove N parameter and adjust.
+	(elaborate_reference): Add INIT parameter and pass it in the call to
+	gnat_rewrite_reference.  Adjust initial expression.
+	* gcc-interface/trans.c (Call_to_gnu): Treat renamings the same way as
+	regular object declarations when it comes to creating a temporary.
+	Adjust call to gnat_stabilize_reference and build a compound expression
+ 	if needed.  Invoke return_type_with_variable_size_p.
+	(gnat_to_gnu): Invoke type_is_padding_self_referential.  In case #4,
+	return a call to a function unmodified if it returns with variable size
+ 	and is also the initial expression in an object declaration.
+	* gcc-interface/utils2.c (build_binary_op) <INIT_EXPR>: Use the RHS'
+	type if it is a call to a function that returns with variable size.
+	(build_unary_op): Invoke type_is_padding_self_referential.
+	(gnat_stabilize_reference_1): Remove N parameter and adjust.
+	(gnat_stabilize_reference): Add INIT parameter and pass it in the call
+	to gnat_rewrite_reference.
+	(gnat_rewrite_reference):  Remove N, add INIT parameter and adjust.
+	<COMPOUND_EXPR>: New case.
+
 2015-05-28  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch3.adb (Is_Visible_Component): Component is visible

gcc/ada/gcc-interface/decl.c

@@ -168,7 +168,6 @@ struct value_annotation_hasher : ggc_cache_hasher<tree_int_map *>
 
 static GTY ((cache)) hash_table<value_annotation_hasher> *annotate_value_cache;
 
-static bool allocatable_size_p (tree, bool);
 static void prepend_one_attribute (struct attrib **,
 				   enum attr_type, tree, tree, Node_Id);
 static void prepend_one_attribute_pragma (struct attrib **, Node_Id);
@@ -179,7 +178,7 @@ static bool type_has_variable_size (tree);
 static tree elaborate_expression_1 (tree, Entity_Id, const char *, bool, bool);
 static tree elaborate_expression_2 (tree, Entity_Id, const char *, bool, bool,
 				    unsigned int);
-static tree elaborate_reference (tree, Entity_Id, bool);
+static tree elaborate_reference (tree, Entity_Id, bool, tree *);
 static tree gnat_to_gnu_component_type (Entity_Id, bool, bool);
 static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool,
 			       bool *);
@@ -189,8 +188,10 @@ static tree change_qualified_type (tree, int);
 static bool same_discriminant_p (Entity_Id, Entity_Id);
 static bool array_type_has_nonaliased_component (tree, Entity_Id);
 static bool compile_time_known_address_p (Node_Id);
-static bool cannot_be_superflat_p (Node_Id);
+static bool cannot_be_superflat (Node_Id);
 static bool constructor_address_p (tree);
+static bool allocatable_size_p (tree, bool);
+static bool initial_value_needs_conversion (tree, tree);
 static int compare_field_bitpos (const PTR, const PTR);
 static bool components_to_record (tree, Node_Id, tree, int, bool, bool, bool,
 				  bool, bool, bool, bool, bool, tree, tree *);
@@ -957,8 +958,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	   to make it more likely to rename the underlying object.  */
 	if (Present (Renamed_Object (gnat_entity)))
 	  {
-	    /* If the renamed object had padding, strip off the reference
-	       to the inner object and reset our type.  */
+	    /* If the renamed object had padding, strip off the reference to
+	       the inner object and reset our type.  */
 	    if ((TREE_CODE (gnu_expr) == COMPONENT_REF
 		 && TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (gnu_expr, 0))))
 		/* Strip useless conversions around the object.  */
@@ -970,10 +971,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
 	    /* Or else, if the renamed object has an unconstrained type with
 	       default discriminant, use the padded type.  */
-	    else if (TYPE_IS_PADDING_P (TREE_TYPE (gnu_expr))
-		     && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_expr)))
-			== gnu_type
-		     && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
+	    else if (type_is_padding_self_referential (TREE_TYPE (gnu_expr)))
 	      gnu_type = TREE_TYPE (gnu_expr);
 
 	    /* Case 1: if this is a constant renaming stemming from a function
@@ -1001,12 +999,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    /* Case 2: if the renaming entity need not be materialized, use
 	       the elaborated renamed expression for the renaming.  But this
 	       means that the caller is responsible for evaluating the address
-	       of the renaming at the correct spot in the definition case to
+	       of the renaming in the correct place for the definition case to
 	       instantiate the SAVE_EXPRs.  */
-	    else if (!Materialize_Entity (gnat_entity))
+	    else if (TREE_CODE (inner) != COMPOUND_EXPR
+		     && !Materialize_Entity (gnat_entity))
 	      {
+		tree init = NULL_TREE;
+
 		gnu_decl
-		  = elaborate_reference (gnu_expr, gnat_entity, definition);
+		  = elaborate_reference (gnu_expr, gnat_entity, definition,
+					 &init);
+
+		/* We cannot evaluate the first arm of a COMPOUND_EXPR in the
+		   correct place for this case, hence the above test.  */
+		gcc_assert (init == NULL_TREE);
 
 		/* No DECL_EXPR will be created so the expression needs to be
 		   marked manually because it will likely be shared.  */
@@ -1039,6 +1045,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	       volatility of the renamed object through the indirection.  */
 	    else
 	      {
+		tree init = NULL_TREE;
+
 		if (TREE_THIS_VOLATILE (gnu_expr) && !TYPE_VOLATILE (gnu_type))
 		  gnu_type
 		    = change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE);
@@ -1050,7 +1058,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		gnu_size = NULL_TREE;
 
 		renamed_obj
-		  = elaborate_reference (gnu_expr, gnat_entity, definition);
+		  = elaborate_reference (gnu_expr, gnat_entity, definition,
+					 &init);
 
 		/* If we are not defining the entity, the expression will not
 		   be attached through DECL_INITIAL so it needs to be marked
@@ -1064,8 +1073,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		    && TREE_CODE (renamed_obj) == ERROR_MARK)
 		  gnu_expr = NULL_TREE;
 		else
+		  {
 		    gnu_expr
 		      = build_unary_op (ADDR_EXPR, gnu_type, renamed_obj);
+		    if (init)
+		      gnu_expr
+			= build_compound_expr (TREE_TYPE (gnu_expr), init,
+					       gnu_expr);
+		  }
 	      }
 	  }
 
@@ -1115,24 +1130,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    gnu_expr = gnat_build_constructor (gnu_type, v);
 	  }
 
-	/* Convert the expression to the type of the object except in the
-	   case where the object's type is unconstrained or the object's type
-	   is a padded record whose field is of self-referential size.  In
-	   the former case, converting will generate unnecessary evaluations
-	   of the CONSTRUCTOR to compute the size and in the latter case, we
-	   want to only copy the actual data.  Also don't convert to a record
-	   type with a variant part from a record type without one, to keep
-	   the object simpler.  */
-	if (gnu_expr
-	    && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
-	    && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
-	    && !(TYPE_IS_PADDING_P (gnu_type)
-		 && CONTAINS_PLACEHOLDER_P
-		    (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))
-	    && !(TREE_CODE (gnu_type) == RECORD_TYPE
-		 && TREE_CODE (TREE_TYPE (gnu_expr)) == RECORD_TYPE
-		 && get_variant_part (gnu_type) != NULL_TREE
-		 && get_variant_part (TREE_TYPE (gnu_expr)) == NULL_TREE))
+	/* Convert the expression to the type of the object if need be.  */
+	if (gnu_expr && initial_value_needs_conversion (gnu_type, gnu_expr))
 	  gnu_expr = convert (gnu_type, gnu_expr);
 
 	/* If this is a pointer that doesn't have an initializing expression,
@@ -1380,24 +1379,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	if (const_flag)
 	  gnu_type = change_qualified_type (gnu_type, TYPE_QUAL_CONST);
 
-	/* Convert the expression to the type of the object except in the
-	   case where the object's type is unconstrained or the object's type
-	   is a padded record whose field is of self-referential size.  In
-	   the former case, converting will generate unnecessary evaluations
-	   of the CONSTRUCTOR to compute the size and in the latter case, we
-	   want to only copy the actual data.  Also don't convert to a record
-	   type with a variant part from a record type without one, to keep
-	   the object simpler.  */
-	if (gnu_expr
-	    && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
-	    && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
-	    && !(TYPE_IS_PADDING_P (gnu_type)
-		 && CONTAINS_PLACEHOLDER_P
-		    (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))
-	    && !(TREE_CODE (gnu_type) == RECORD_TYPE
-		 && TREE_CODE (TREE_TYPE (gnu_expr)) == RECORD_TYPE
-		 && get_variant_part (gnu_type) != NULL_TREE
-		 && get_variant_part (TREE_TYPE (gnu_expr)) == NULL_TREE))
+	/* Convert the expression to the type of the object if need be.  */
+	if (gnu_expr && initial_value_needs_conversion (gnu_type, gnu_expr))
 	  gnu_expr = convert (gnu_type, gnu_expr);
 
 	/* If this name is external or a name was specified, use it, but don't
@@ -2334,7 +2317,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		 this.  If we can prove that the array can never be superflat,
 		 we can just use the high bound of the index type.  */
 	      else if ((Nkind (gnat_index) == N_Range
-		        && cannot_be_superflat_p (gnat_index))
+		        && cannot_be_superflat (gnat_index))
 		       /* Bit-Packed Array Impl. Types are never superflat.  */
 		       || (Is_Packed_Array_Impl_Type (gnat_entity)
 			   && Is_Bit_Packed_Array
@@ -5821,7 +5804,7 @@ compile_time_known_address_p (Node_Id gnat_address)
    inequality HB >= LB-1 is true.  LB and HB are the low and high bounds.  */
 
 static bool
-cannot_be_superflat_p (Node_Id gnat_range)
+cannot_be_superflat (Node_Id gnat_range)
 {
   Node_Id gnat_lb = Low_Bound (gnat_range), gnat_hb = High_Bound (gnat_range);
   Node_Id scalar_range;
@@ -5878,6 +5861,57 @@ constructor_address_p (tree gnu_expr)
 	  && TREE_CODE (TREE_OPERAND (gnu_expr, 0)) == CONSTRUCTOR);
 }
 
+/* Return true if the size in units represented by GNU_SIZE can be handled by
+   an allocation.  If STATIC_P is true, consider only what can be done with a
+   static allocation.  */
+
+static bool
+allocatable_size_p (tree gnu_size, bool static_p)
+{
+  /* We can allocate a fixed size if it is a valid for the middle-end.  */
+  if (TREE_CODE (gnu_size) == INTEGER_CST)
+    return valid_constant_size_p (gnu_size);
+
+  /* We can allocate a variable size if this isn't a static allocation.  */
+  else
+    return !static_p;
+}
+
+/* Return true if GNU_EXPR needs a conversion to GNU_TYPE when used as the
+   initial value of an object of GNU_TYPE.  */
+
+static bool
+initial_value_needs_conversion (tree gnu_type, tree gnu_expr)
+{
+  /* Do not convert if the object's type is unconstrained because this would
+     generate useless evaluations of the CONSTRUCTOR to compute the size.  */
+  if (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
+      || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
+    return false;
+
+  /* Do not convert if the object's type is a padding record whose field is of
+     self-referential size because we want to copy only the actual data.  */
+  if (type_is_padding_self_referential (gnu_type))
+    return false;
+
+  /* Do not convert a call to a function that returns with variable size since
+     we want to use the return slot optimization in this case.  */
+  if (TREE_CODE (gnu_expr) == CALL_EXPR
+      && return_type_with_variable_size_p (TREE_TYPE (gnu_expr)))
+    return false;
+
+  /* Do not convert to a record type with a variant part from a record type
+     without one, to keep the object simpler.  */
+  if (TREE_CODE (gnu_type) == RECORD_TYPE
+      && TREE_CODE (TREE_TYPE (gnu_expr)) == RECORD_TYPE
+      && get_variant_part (gnu_type) != NULL_TREE
+      && get_variant_part (TREE_TYPE (gnu_expr)) == NULL_TREE)
+    return false;
+
+  /* In all the other cases, convert the expression to the object's type.  */
+  return true;
+}
+
 /* Given GNAT_ENTITY, elaborate all expressions that are required to
    be elaborated at the point of its definition, but do nothing else.  */
 
@@ -5935,22 +5969,6 @@ elaborate_entity (Entity_Id gnat_entity)
     }
 }
 
-/* Return true if the size in units represented by GNU_SIZE can be handled by
-   an allocation.  If STATIC_P is true, consider only what can be done with a
-   static allocation.  */
-
-static bool
-allocatable_size_p (tree gnu_size, bool static_p)
-{
-  /* We can allocate a fixed size if it is a valid for the middle-end.  */
-  if (TREE_CODE (gnu_size) == INTEGER_CST)
-    return valid_constant_size_p (gnu_size);
-
-  /* We can allocate a variable size if this isn't a static allocation.  */
-  else
-    return !static_p;
-}
-
 /* Prepend to ATTR_LIST an entry for an attribute with provided TYPE,
    NAME, ARGS and ERROR_POINT.  */
 
@@ -6224,12 +6242,13 @@ struct er_data
 {
   Entity_Id entity;
   bool definition;
+  unsigned int n;
 };
 
 /* Wrapper function around elaborate_expression_1 for elaborate_reference.  */
 
 static tree
-elaborate_reference_1 (tree ref, void *data, int n)
+elaborate_reference_1 (tree ref, void *data)
 {
   struct er_data *er = (struct er_data *)data;
   char suffix[16];
@@ -6244,22 +6263,24 @@ elaborate_reference_1 (tree ref, void *data, int n)
   if (TREE_CODE (ref) == COMPONENT_REF
       && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (ref, 0))))
     return build3 (COMPONENT_REF, TREE_TYPE (ref),
-		   elaborate_reference_1 (TREE_OPERAND (ref, 0), data, n),
+		   elaborate_reference_1 (TREE_OPERAND (ref, 0), data),
 		   TREE_OPERAND (ref, 1), TREE_OPERAND (ref, 2));
 
-  sprintf (suffix, "EXP%d", n);
+  sprintf (suffix, "EXP%d", ++er->n);
   return
     elaborate_expression_1 (ref, er->entity, suffix, er->definition, false);
 }
 
 /* Elaborate the reference REF to be used as renamed object for GNAT_ENTITY.
-   DEFINITION is true if this is done for a definition of GNAT_ENTITY.  */
+   DEFINITION is true if this is done for a definition of GNAT_ENTITY and
+   INIT is set to the first arm of a COMPOUND_EXPR present in REF, if any.  */
 
 static tree
-elaborate_reference (tree ref, Entity_Id gnat_entity, bool definition)
+elaborate_reference (tree ref, Entity_Id gnat_entity, bool definition,
+		     tree *init)
 {
-  struct er_data er = { gnat_entity, definition };
-  return gnat_rewrite_reference (ref, elaborate_reference_1, &er);
+  struct er_data er = { gnat_entity, definition, 0 };
+  return gnat_rewrite_reference (ref, elaborate_reference_1, &er, init);
 }
 
 /* Given a GNU tree and a GNAT list of choices, generate an expression to test

gcc/ada/gcc-interface/gigi.h

@@ -959,16 +959,16 @@ extern tree gnat_protect_expr (tree exp);
 
 /* This is equivalent to stabilize_reference in tree.c but we know how to
    handle our own nodes and we take extra arguments.  FORCE says whether to
-   force evaluation of everything.  */
-extern tree gnat_stabilize_reference (tree ref, bool force);
+   force evaluation of everything in REF.  INIT is set to the first arm of
+   a COMPOUND_EXPR present in REF, if any.  */
+extern tree gnat_stabilize_reference (tree ref, bool force, tree *init);
 
 /* Rewrite reference REF and call FUNC on each expression within REF in the
-   process.  DATA is passed unmodified to FUNC and N is bumped each time it
-   is passed to FUNC, so FUNC is guaranteed to see a given N only once per
-   reference to be rewritten.  */
-typedef tree (*rewrite_fn) (tree, void *, int);
+   process.  DATA is passed unmodified to FUNC.  INIT is set to the first
+   arm of a COMPOUND_EXPR present in REF, if any.  */
+typedef tree (*rewrite_fn) (tree, void *);
 extern tree gnat_rewrite_reference (tree ref, rewrite_fn func, void *data,
-				    int n = 1);
+				    tree *init);
 
 /* This is equivalent to get_inner_reference in expr.c but it returns the
    ultimate containing object only if the reference (lvalue) is constant,
@@ -1085,3 +1085,30 @@ call_is_atomic_load (tree exp)
   enum built_in_function code = DECL_FUNCTION_CODE (fndecl);
   return BUILT_IN_ATOMIC_LOAD_N <= code && code <= BUILT_IN_ATOMIC_LOAD_16;
 }
+
+/* Return true if TYPE is padding a self-referential type.  */
+
+static inline bool
+type_is_padding_self_referential (tree type)
+{
+  if (!TYPE_IS_PADDING_P (type))
+    return false;
+
+  return CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type)));
+}
+
+/* Return true if a function returning TYPE doesn't return a fixed size.  */
+
+static inline bool
+return_type_with_variable_size_p (tree type)
+{
+  if (TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST)
+    return true;
+
+  /* Return true for an unconstrained type with default discriminant, see
+     the E_Subprogram_Type case of gnat_to_gnu_entity.  */
+  if (type_is_padding_self_referential (type))
+    return true;
+
+  return false;
+}

gcc/ada/gcc-interface/trans.c

@@ -4189,9 +4189,9 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
 	  because we need to preserve the return value before copying back the
 	  parameters.
 
-       2. There is no target and this is not an object declaration, and the
-	  return type has variable size, because in these cases the gimplifier
-	  cannot create the temporary.
+       2. There is no target and this is neither an object nor a renaming
+	  declaration, and the return type has variable size, because in
+	  these cases the gimplifier cannot create the temporary.
 
        3. There is a target and it is a slice or an array with fixed size,
 	  and the return type has variable size, because the gimplifier
@@ -4203,6 +4203,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
       && ((!gnu_target && TYPE_CI_CO_LIST (gnu_subprog_type))
 	  || (!gnu_target
 	      && Nkind (Parent (gnat_node)) != N_Object_Declaration
+	      && Nkind (Parent (gnat_node)) != N_Object_Renaming_Declaration
 	      && TREE_CODE (TYPE_SIZE (gnu_result_type)) != INTEGER_CST)
 	  || (gnu_target
 	      && (TREE_CODE (gnu_target) == ARRAY_RANGE_REF
@@ -4258,7 +4259,13 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
       if (Ekind (gnat_formal) != E_In_Parameter
 	  && !is_by_ref_formal_parm
 	  && TREE_CODE (gnu_name) != NULL_EXPR)
-	gnu_name = gnat_stabilize_reference (gnu_name, true);
+	{
+	  tree init = NULL_TREE;
+	  gnu_name = gnat_stabilize_reference (gnu_name, true, &init);
+	  if (init)
+	    gnu_name
+	      = build_compound_expr (TREE_TYPE (gnu_name), init, gnu_name);
+	}
 
       /* If we are passing a non-addressable parameter by reference, pass the
 	 address of a copy.  In the Out or In Out case, set up to copy back
@@ -4724,12 +4731,8 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
 
 	  /* ??? If the return type has variable size, then force the return
 	     slot optimization as we would not be able to create a temporary.
-	     Likewise if it was unconstrained as we would copy too much data.
 	     That's what has been done historically.  */
-	  if (TREE_CODE (TYPE_SIZE (gnu_result_type)) != INTEGER_CST
-	      || (TYPE_IS_PADDING_P (gnu_result_type)
-		  && CONTAINS_PLACEHOLDER_P
-		     (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_result_type))))))
+	  if (return_type_with_variable_size_p (gnu_result_type))
 	    op_code = INIT_EXPR;
 	  else
 	    op_code = MODIFY_EXPR;
@@ -6802,10 +6805,8 @@ gnat_to_gnu (Node_Id gnat_node)
 	    /* Do not remove the padding from GNU_RET_VAL if the inner type is
 	       self-referential since we want to allocate the fixed size.  */
 	    if (TREE_CODE (gnu_ret_val) == COMPONENT_REF
-		&& TYPE_IS_PADDING_P
-		   (TREE_TYPE (TREE_OPERAND (gnu_ret_val, 0)))
-		&& CONTAINS_PLACEHOLDER_P
-		   (TYPE_SIZE (TREE_TYPE (gnu_ret_val))))
+		&& type_is_padding_self_referential
+		   (TREE_OPERAND (gnu_ret_val, 0)))
 	      gnu_ret_val = TREE_OPERAND (gnu_ret_val, 0);
 
 	    /* If the function returns by direct reference, return a pointer
@@ -7486,7 +7487,7 @@ gnat_to_gnu (Node_Id gnat_node)
      actual returned object.  We must do this before any conversions.  */
   if (TREE_SIDE_EFFECTS (gnu_result)
       && !(TREE_CODE (gnu_result) == CALL_EXPR
-	   && TYPE_IS_PADDING_P (TREE_TYPE (gnu_result)))
+	   && type_is_padding_self_referential (TREE_TYPE (gnu_result)))
       && (TREE_CODE (gnu_result_type) == UNCONSTRAINED_ARRAY_TYPE
 	  || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type))))
     gnu_result = gnat_protect_expr (gnu_result);
@@ -7512,9 +7513,10 @@ gnat_to_gnu (Node_Id gnat_node)
        3. If the type is void or if we have no result, return error_mark_node
 	  to show we have no result.
 
-       4. If this a call to a function that returns an unconstrained type with
-	  default discriminant, return the call expression unmodified since we
-	  cannot compute the size of the actual returned object.
+       4. If this is a call to a function that returns with variable size and
+	  the call is used as the expression in either an object or a renaming
+	  declaration, return the result unmodified because we want to use the
+	  return slot optimization in this case.
 
        5. Finally, if the type of the result is already correct.  */
 
@@ -7543,9 +7545,7 @@ gnat_to_gnu (Node_Id gnat_node)
 	 size: in that case it must be an object of unconstrained type
 	 with a default discriminant and we want to avoid copying too
 	 much data.  */
-      if (TYPE_IS_PADDING_P (TREE_TYPE (gnu_result))
-	  && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS
-				     (TREE_TYPE (gnu_result))))))
+      if (type_is_padding_self_referential (TREE_TYPE (gnu_result)))
 	gnu_result = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_result))),
 			      gnu_result);
     }
@@ -7567,11 +7567,11 @@ gnat_to_gnu (Node_Id gnat_node)
   else if (gnu_result == error_mark_node || gnu_result_type == void_type_node)
     gnu_result = error_mark_node;
 
-  else if (TREE_CODE (gnu_result) == CALL_EXPR
-	   && TYPE_IS_PADDING_P (TREE_TYPE (gnu_result))
-	   && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_result)))
-	      == gnu_result_type
-	   && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type)))
+  else if (Present (Parent (gnat_node))
+	   && (Nkind (Parent (gnat_node)) == N_Object_Declaration
+	       || Nkind (Parent (gnat_node)) == N_Object_Renaming_Declaration)
+	   && TREE_CODE (gnu_result) == CALL_EXPR
+	   && return_type_with_variable_size_p (TREE_TYPE (gnu_result)))
     ;
 
   else if (TREE_TYPE (gnu_result) != gnu_result_type)

gcc/ada/gcc-interface/utils2.c

@@ -923,13 +923,10 @@ build_binary_op (enum tree_code op_code, tree result_type,
 	    operation_type = left_type;
 	}
 
-      /* If we have a call to a function that returns an unconstrained type
-	 with default discriminant on the RHS, use the RHS type (which is
-	 padded) as we cannot compute the size of the actual assignment.  */
+      /* If we have a call to a function that returns with variable size, use
+	 the RHS type in case we want to use the return slot optimization.  */
       else if (TREE_CODE (right_operand) == CALL_EXPR
-	       && TYPE_IS_PADDING_P (right_type)
-	       && CONTAINS_PLACEHOLDER_P
-		  (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (right_type)))))
+	       && return_type_with_variable_size_p (right_type))
 	operation_type = right_type;
 
       /* Find the best type to use for copying between aggregate types.  */
@@ -1420,10 +1417,7 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
 	      /* If INNER is a padding type whose field has a self-referential
 		 size, convert to that inner type.  We know the offset is zero
 		 and we need to have that type visible.  */
-	      if (TYPE_IS_PADDING_P (TREE_TYPE (inner))
-		  && CONTAINS_PLACEHOLDER_P
-		     (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS
-					    (TREE_TYPE (inner))))))
+	      if (type_is_padding_self_referential (TREE_TYPE (inner)))
 		inner = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (inner))),
 				 inner);
 
@@ -2663,7 +2657,7 @@ gnat_protect_expr (tree exp)
    argument to force evaluation of everything.  */
 
 static tree
-gnat_stabilize_reference_1 (tree e, void *data, int n)
+gnat_stabilize_reference_1 (tree e, void *data)
 {
   const bool force = *(bool *)data;
   enum tree_code code = TREE_CODE (e);
@@ -2688,7 +2682,7 @@ gnat_stabilize_reference_1 (tree e, void *data, int n)
 	  && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0))))
 	result
 	  = build3 (code, type,
-		    gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data, n),
+		    gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data),
 		    TREE_OPERAND (e, 1), TREE_OPERAND (e, 2));
       /* If the expression has side-effects, then encase it in a SAVE_EXPR
 	 so that it will only be evaluated once.  */
@@ -2704,15 +2698,15 @@ gnat_stabilize_reference_1 (tree e, void *data, int n)
       /* Recursively stabilize each operand.  */
       result
 	= build2 (code, type,
-		  gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data, n),
-		  gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), data, n));
+		  gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data),
+		  gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), data));
       break;
 
     case tcc_unary:
       /* Recursively stabilize each operand.  */
       result
 	= build1 (code, type,
-		  gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data, n));
+		  gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data));
       break;
 
     default:
@@ -2728,21 +2722,22 @@ gnat_stabilize_reference_1 (tree e, void *data, int n)
 
 /* This is equivalent to stabilize_reference in tree.c but we know how to
    handle our own nodes and we take extra arguments.  FORCE says whether to
-   force evaluation of everything.  */
+   force evaluation of everything in REF.  INIT is set to the first arm of
+   a COMPOUND_EXPR present in REF, if any.  */
 
 tree
-gnat_stabilize_reference (tree ref, bool force)
+gnat_stabilize_reference (tree ref, bool force, tree *init)
 {
-  return gnat_rewrite_reference (ref, gnat_stabilize_reference_1, &force);
+  return
+    gnat_rewrite_reference (ref, gnat_stabilize_reference_1, &force, init);
 }
 
 /* Rewrite reference REF and call FUNC on each expression within REF in the
-   process.  DATA is passed unmodified to FUNC and N is bumped each time it
-   is passed to FUNC, so FUNC is guaranteed to see a given N only once per
-   reference to be rewritten.  */
+   process.  DATA is passed unmodified to FUNC.  INIT is set to the first
+   arm of a COMPOUND_EXPR present in REF, if any.  */
 
 tree
-gnat_rewrite_reference (tree ref, rewrite_fn func, void *data, int n)
+gnat_rewrite_reference (tree ref, rewrite_fn func, void *data, tree *init)
 {
   tree type = TREE_TYPE (ref);
   enum tree_code code = TREE_CODE (ref);
@@ -2764,25 +2759,25 @@ gnat_rewrite_reference (tree ref, rewrite_fn func, void *data, int n)
       result
 	= build1 (code, type,
 		  gnat_rewrite_reference (TREE_OPERAND (ref, 0), func, data,
-					  n));
+					  init));
       break;
 
     case INDIRECT_REF:
     case UNCONSTRAINED_ARRAY_REF:
-      result = build1 (code, type, func (TREE_OPERAND (ref, 0), data, n));
+      result = build1 (code, type, func (TREE_OPERAND (ref, 0), data));
       break;
 
     case COMPONENT_REF:
       result = build3 (COMPONENT_REF, type,
 		       gnat_rewrite_reference (TREE_OPERAND (ref, 0), func,
-					       data, n),
+					       data, init),
 		       TREE_OPERAND (ref, 1), NULL_TREE);
       break;
 
     case BIT_FIELD_REF:
       result = build3 (BIT_FIELD_REF, type,
 		       gnat_rewrite_reference (TREE_OPERAND (ref, 0), func,
-					       data, n),
+					       data, init),
 		       TREE_OPERAND (ref, 1), TREE_OPERAND (ref, 2));
       break;
 
@@ -2791,11 +2786,18 @@ gnat_rewrite_reference (tree ref, rewrite_fn func, void *data, int n)
       result
 	= build4 (code, type,
 		  gnat_rewrite_reference (TREE_OPERAND (ref, 0), func, data,
-					  n + 1),
-		  func (TREE_OPERAND (ref, 1), data, n),
+					  init),
+		  func (TREE_OPERAND (ref, 1), data),
 		  TREE_OPERAND (ref, 2), TREE_OPERAND (ref, 3));
       break;
 
+    case COMPOUND_EXPR:
+      gcc_assert (*init == NULL_TREE);
+      *init = TREE_OPERAND (ref, 0);
+      /* We expect only the pattern built in Call_to_gnu.  */
+      gcc_assert (DECL_P (TREE_OPERAND (ref, 1)));
+      return TREE_OPERAND (ref, 1);
+
     case CALL_EXPR:
       {
 	/* This can only be an atomic load.  */
@@ -2808,9 +2810,9 @@ gnat_rewrite_reference (tree ref, rewrite_fn func, void *data, int n)
 	if (TREE_CODE (t) == ADDR_EXPR)
 	  t = build1 (ADDR_EXPR, TREE_TYPE (t),
 		      gnat_rewrite_reference (TREE_OPERAND (t, 0), func, data,
-					      n));
+					      init));
 	else
-	  t = func (t, data, n);
+	  t = func (t, data);
 	t = fold_convert (TREE_TYPE (CALL_EXPR_ARG (ref, 0)), t);
 
 	result = build_call_expr (TREE_OPERAND (CALL_EXPR_FN (ref), 0), 2,

gcc/testsuite/ChangeLog

+2015-05-28  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/varsize_temp.adb: Rename into...
+	* gnat.dg/varsize1.adb: ...this.
+	* gnat.dg/varsize_copy.ad[sb]: Rename into...
+	* gnat.dg/varsize2.ad[sb]: ...this.
+	* gnat.dg/varsize3_1.adb: New test.
+	* gnat.dg/varsize3_2.adb: Likewise.
+	* gnat.dg/varsize3_3.adb: Likewise.
+	* gnat.dg/varsize3_4.adb: Likewise.
+	* gnat.dg/varsize3_5.adb: Likewise.
+	* gnat.dg/varsize3_6.adb: Likewise.
+	* gnat.dg/varsize3_pkg1.ads: New helper.
+	* gnat.dg/varsize3_pkg2.ads: Likewise.
+	* gnat.dg/varsize3_pkg3.ads: Likewise.
+
 2015-05-28  Richard Biener  <rguenther@suse.de>
 
 	* gcc.dg/vect/slp-reduc-sad.c: New testcase.

gcc/testsuite/gnat.dg/varsize_temp.adb → gcc/testsuite/gnat.dg/varsize1.adb

 -- { dg-do compile }
 
-procedure Varsize_Temp (Nbytes : Natural) is
+procedure Varsize1 (Nbytes : Natural) is
 
    type Message_T (Length : Natural) is record
       case Length is
@@ -25,5 +25,3 @@ procedure Varsize_Temp (Nbytes : Natural) is
 begin
    Process (One_Message);
 end;
-
-

gcc/testsuite/gnat.dg/varsize_copy.adb → gcc/testsuite/gnat.dg/varsize2.adb

 -- { dg-do compile }
 -- { dg-options "-O -gnatws" }
 
-package body Varsize_Copy is
+package body Varsize2 is
 
    type Key_Mapping_Type is record
       Page : Page_Type;
@@ -21,4 +21,4 @@ package body Varsize_Copy is
       return S.Key_Mappings (Key).Page;
    end;
 
-end Varsize_Copy;
+end Varsize2;

gcc/testsuite/gnat.dg/varsize_copy.ads → gcc/testsuite/gnat.dg/varsize2.ads

-package Varsize_Copy is
+package Varsize2 is
 
    type Key_Type is
       (Nul, Cntrl, Stx, Etx, Eot, Enq, Ack, Spad, Clr, Dc_1, Dc_2, Dc_3, Dc_4);
@@ -27,4 +27,4 @@ package Varsize_Copy is
 
    function F (Key : Key_Type) return Page_Type;
 
-end Varsize_Copy;
+end Varsize2;

gcc/testsuite/gnat.dg/varsize3_1.adb

+-- { dg-do compile }
+
+package body Varsize3_1 is
+
+end Varsize3_1;

gcc/testsuite/gnat.dg/varsize3_1.ads

+with Varsize3_Pkg1; use Varsize3_Pkg1;
+
+package Varsize3_1 is
+
+  pragma Elaborate_Body;
+
+  Filter : constant Object := True;
+
+end Varsize3_1;

gcc/testsuite/gnat.dg/varsize3_2.adb

+-- { dg-do compile }
+
+with Varsize3_Pkg1; use Varsize3_Pkg1;
+
+procedure Varsize3_2 is
+
+  Filter : constant Object := True;
+
+begin
+  null;
+end;

gcc/testsuite/gnat.dg/varsize3_3.adb

+-- { dg-do compile }
+
+with Varsize3_Pkg1; use Varsize3_Pkg1;
+
+procedure Varsize3_3 is
+
+  Filter : Object;
+
+begin
+  Filter := True;
+end;

gcc/testsuite/gnat.dg/varsize3_4.adb

+-- { dg-do compile }
+
+with Varsize3_Pkg1; use Varsize3_Pkg1;
+
+procedure Varsize3_4 is
+
+  Filter : Object renames True;
+
+begin
+  null;
+end;

gcc/testsuite/gnat.dg/varsize3_5.adb

+-- { dg-do compile }
+
+with Varsize3_Pkg1; use Varsize3_Pkg1;
+
+procedure Varsize3_5 is
+
+  Filter : constant Arr := True.E;
+
+begin
+  null;
+end;

gcc/testsuite/gnat.dg/varsize3_6.adb

+-- { dg-do compile }
+
+with Varsize3_Pkg1; use Varsize3_Pkg1;
+
+procedure Varsize3_6 is
+
+  Filter : Arr renames True.E;
+
+begin
+  null;
+end;

gcc/testsuite/gnat.dg/varsize3_pkg1.ads

+with Varsize3_Pkg2;
+with Varsize3_Pkg3;
+
+package Varsize3_Pkg1 is
+
+   type Arr is array (Positive range 1 .. Varsize3_Pkg2.Last_Index) of Boolean;
+
+   package My_G is new Varsize3_Pkg3 (Arr);
+
+   type Object is new My_G.Object;
+
+end Varsize3_Pkg1;

gcc/testsuite/gnat.dg/varsize3_pkg2.ads

+package Varsize3_Pkg2 is
+
+   function Last_Index return Positive;
+
+end Varsize3_Pkg2;

gcc/testsuite/gnat.dg/varsize3_pkg3.ads

+generic
+
+   type T is private;
+
+package Varsize3_Pkg3 is
+
+   type Object is record
+      E : T;
+   end record;
+
+   function True return Object;
+
+end Varsize3_Pkg3;