gimplify.c (prepare_gimple_addressable): New static function.

	* gimplify.c (prepare_gimple_addressable): New static function.
	(gimplify_modify_expr_to_memcpy): Invoke it on the RHS before marking
	it addressable.
	(gimplify_addr_expr): Invoke it similarly on the operand instead of
	manually fiddling with it.
ada/
	* gcc-interface/trans.c (call_to_gnu): Tidy.
	(gnat_to_gnu) <N_Slice>: Set TYPE_ARRAY_MAX_SIZE if the slice has
	non-constant size but the array itself has constant size.
	* gcc-interface/utils.c (convert_vms_descriptor64): Fix type
	consistency error.
	(convert_vms_descriptor32): Likewise.

From-SVN: r151082

8 files changed, 106 insertions, 19 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index cadeace..c981d54 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,11 @@
+2009-08-25  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gimplify.c (prepare_gimple_addressable): New static function.
+	(gimplify_modify_expr_to_memcpy): Invoke it on the RHS before marking
+	it addressable.
+	(gimplify_addr_expr): Invoke it similarly on the operand instead of
+	manually fiddling with it.
+
 2009-08-25  Michael Matz  <matz@suse.de>
 
 	* expr.h (jumpifnot_1, jumpif_1, do_jump_1): Declare.
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3cf2429..ede9b4d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2009-08-25  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/trans.c (call_to_gnu): Tidy.
+	(gnat_to_gnu) <N_Slice>: Set TYPE_ARRAY_MAX_SIZE if the slice has
+	non-constant size but the array itself has constant size.
+	* gcc-interface/utils.c (convert_vms_descriptor64): Fix type
+	consistency error.
+	(convert_vms_descriptor32): Likewise.
+
 2009-08-22  Aurelien Jarno  <aurelien@aurel32.net>
 
 	* gcc-interface/Makefile.in: Add Ada support for 
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index b3a201f..7333f8c 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -2506,7 +2506,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 	  && (gnu_name_type = gnat_to_gnu_type (Etype (gnat_name)))
 	  && !addressable_p (gnu_name, gnu_name_type))
 	{
-	  tree gnu_copy = gnu_name, gnu_temp;
+	  tree gnu_copy = gnu_name;
 
 	  /* If the type is by_reference, a copy is not allowed.  */
 	  if (Is_By_Reference_Type (Etype (gnat_formal)))
@@ -2569,10 +2569,10 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 	  /* Set up to move the copy back to the original.  */
 	  if (Ekind (gnat_formal) != E_In_Parameter)
 	    {
-	      gnu_temp = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_copy,
-					  gnu_name);
-	      set_expr_location_from_node (gnu_temp, gnat_node);
-	      append_to_statement_list (gnu_temp, &gnu_after_list);
+	      tree stmt = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_copy,
+					   gnu_name);
+	      set_expr_location_from_node (stmt, gnat_node);
+	      append_to_statement_list (stmt, &gnu_after_list);
 	    }
 	}
 
@@ -3889,8 +3889,8 @@ gnat_to_gnu (Node_Id gnat_node)
 
     case N_Slice:
       {
-	tree gnu_type;
 	Node_Id gnat_range_node = Discrete_Range (gnat_node);
+	tree gnu_type;
 
 	gnu_result = gnat_to_gnu (Prefix (gnat_node));
 	gnu_result_type = get_unpadded_type (Etype (gnat_node));
@@ -3963,6 +3963,12 @@ gnat_to_gnu (Node_Id gnat_node)
 	  /* Simply return the naked low bound.  */
 	  gnu_expr = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_result_type));
 
+	/* If this is a slice with non-constant size of an array with constant
+	   size, set the maximum size for the allocation of temporaries.  */
+	if (!TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_result_type))
+	    && TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_type)))
+	  TYPE_ARRAY_MAX_SIZE (gnu_result_type) = TYPE_SIZE_UNIT (gnu_type);
+
 	gnu_result = build_binary_op (ARRAY_RANGE_REF, gnu_result_type,
 				      gnu_result, gnu_expr);
       }
diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index f209dcc..9748caf 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -3244,7 +3244,7 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
 			 tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)),
                                     ufield, NULL_TREE));
 	  template_tree = gnat_build_constructor (template_type, t);
-	  template_tree = build3 (COND_EXPR, p_bounds_type, u,
+	  template_tree = build3 (COND_EXPR, template_type, u,
 			    build_call_raise (CE_Length_Check_Failed, Empty,
 					      N_Raise_Constraint_Error),
 			    template_tree);
@@ -3365,7 +3365,7 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
 	  t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (t))));
 	  template_tree
 	    = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
-	  template_tree = build3 (COND_EXPR, p_bounds_type, u,
+	  template_tree = build3 (COND_EXPR, TREE_TYPE (t), u,
 			    build_call_raise (CE_Length_Check_Failed, Empty,
 					      N_Raise_Constraint_Error),
 			    template_tree);
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index 3ba40a8..bdb64ea 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -3095,6 +3095,25 @@ gimplify_cond_expr (tree *expr_p, gimple_seq *pre_p, fallback_t fallback)
   return ret;
 }
 
+/* Prepare the node pointed to by EXPR_P, an is_gimple_addressable expression,
+   to be marked addressable.
+
+   We cannot rely on such an expression being directly markable if a temporary
+   has been created by the gimplification.  In this case, we create another
+   temporary and initialize it with a copy, which will become a store after we
+   mark it addressable.  This can happen if the front-end passed us something
+   that it could not mark addressable yet, like a Fortran pass-by-reference
+   parameter (int) floatvar.  */
+
+static void
+prepare_gimple_addressable (tree *expr_p, gimple_seq *seq_p)
+{
+  while (handled_component_p (*expr_p))
+    expr_p = &TREE_OPERAND (*expr_p, 0);
+  if (is_gimple_reg (*expr_p))
+    *expr_p = get_initialized_tmp_var (*expr_p, seq_p, NULL);
+}
+
 /* A subroutine of gimplify_modify_expr.  Replace a MODIFY_EXPR with
    a call to __builtin_memcpy.  */
 
@@ -3109,6 +3128,10 @@ gimplify_modify_expr_to_memcpy (tree *expr_p, tree size, bool want_value,
   to = TREE_OPERAND (*expr_p, 0);
   from = TREE_OPERAND (*expr_p, 1);
 
+  /* Mark the RHS addressable.  Beware that it may not be possible to do so
+     directly if a temporary has been created by the gimplification.  */
+  prepare_gimple_addressable (&from, seq_p);
+
   mark_addressable (from);
   from_ptr = build_fold_addr_expr_loc (loc, from);
   gimplify_arg (&from_ptr, seq_p, loc);
@@ -4685,22 +4708,15 @@ gimplify_addr_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p)
 	 gcc.dg/c99-array-lval-1.c.  The gimplifier will correctly make
 	 the implied temporary explicit.  */
 
-      /* Mark the RHS addressable.  */
+      /* Make the operand addressable.  */
       ret = gimplify_expr (&TREE_OPERAND (expr, 0), pre_p, post_p,
 			   is_gimple_addressable, fb_either);
       if (ret == GS_ERROR)
 	break;
 
-      /* We cannot rely on making the RHS addressable if it is
-	 a temporary created by gimplification.  In this case create a
-	 new temporary that is initialized by a copy (which will
-	 become a store after we mark it addressable).
-	 This mostly happens if the frontend passed us something that
-	 it could not mark addressable yet, like a fortran
-	 pass-by-reference parameter (int) floatvar.  */
-      if (is_gimple_reg (TREE_OPERAND (expr, 0)))
-	TREE_OPERAND (expr, 0)
-	  = get_initialized_tmp_var (TREE_OPERAND (expr, 0), pre_p, post_p);
+      /* Then mark it.  Beware that it may not be possible to do so directly
+	 if a temporary has been created by the gimplification.  */
+      prepare_gimple_addressable (&TREE_OPERAND (expr, 0), pre_p);
 
       op0 = TREE_OPERAND (expr, 0);
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 23f669b..7cfcccd 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-08-25  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/slice7.adb: New test.
+	* gnat.dg/slice7_pkg.ads: New helper.
+
 2009-08-25  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/41139
diff --git a/gcc/testsuite/gnat.dg/slice7.adb b/gcc/testsuite/gnat.dg/slice7.adb
new file mode 100644
index 0000000..3f0d3f5
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/slice7.adb
@@ -0,0 +1,36 @@
+-- { dg-do compile }
+-- { dg-options "-gnatws" }
+
+with System.Storage_Elements; use System.Storage_Elements;
+with Unchecked_Conversion;
+with Slice7_Pkg; use Slice7_Pkg;
+
+procedure Slice7 is
+
+  type Discrete_Type is range 1 .. 32;
+
+  Max_Byte_Count : constant := 4;
+  subtype Byte_Count_Type is Storage_Offset range 1..Max_Byte_Count;
+
+  subtype Buffer_Type is Storage_Array (Byte_Count_Type);
+  function Convert_Put is new Unchecked_Conversion (Integer, Buffer_Type);
+
+  function Set_Buffer_Size return Byte_Count_Type is
+  begin
+    return 4;
+  end;
+
+  Buffer_Size  : constant Byte_Count_Type := Set_Buffer_Size;
+  Buffer_End   : constant Byte_Count_Type := Max_Byte_Count;
+  Buffer_Start : constant Byte_Count_Type := Buffer_End - Buffer_Size + 1;
+
+  Obj : Discrete_Type;
+
+begin
+  Put (Convert_Put(Discrete_Type'Pos (Obj))
+       (Buffer_Start..Buffer_End));
+
+  Put (Convert_Put(Discrete_Type'Pos (Obj) -
+                   Discrete_Type'Pos (Discrete_Type'First))
+       (Buffer_Start..Buffer_End));
+end;
diff --git a/gcc/testsuite/gnat.dg/slice7_pkg.ads b/gcc/testsuite/gnat.dg/slice7_pkg.ads
new file mode 100644
index 0000000..3c2f4a1
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/slice7_pkg.ads
@@ -0,0 +1,7 @@
+with System.Storage_Elements; use System.Storage_Elements;
+
+package Slice7_Pkg is
+
+  procedure Put (The_Object : in Storage_Array);
+
+end Slice7_Pkg;