2007-12-02  Jakub Jelinek  <jakub@redhat.com>

	* gcc.c-torture/execute/20071202-1.c: New test.

2007-02-19  Eric Botcazou  <ebotcazou@adacore.com>

	* gimplify.c (gimplify_init_ctor_preeval_1): Detect potential overlap
	due to calls to functions taking pointers as parameters.

	* gnat.dg/self_aggregate_with_call.adb: New test.

2006-08-21  Olivier Hainque  <hainque@adacore.com>

	* gimplify.c (gimplify_init_constructor) <RECORD,UNION,ARRAY types>:
	Arrange for the temporary captures of components overlapping the lhs
	to happen before the lhs is possibly cleared.
	
	* gnat.dg/self_aggregate_with_zeros.adb: New test.
	* gnat.dg/self_aggregate_with_array.adb: New test.

--- gcc/gimplify.c	(revision 116299)
+++ gcc/gimplify.c	(revision 116300)
@@ -2638,6 +2638,21 @@ gimplify_init_ctor_preeval_1 (tree *tp, 
       && alias_sets_conflict_p (data->lhs_alias_set, get_alias_set (t)))
     return t;
 
+  /* If the constructor component is a call, determine if it can hide a
+     potential overlap with the lhs through an INDIRECT_REF like above.  */
+  if (TREE_CODE (t) == CALL_EXPR)
+    {
+      tree type, fntype = TREE_TYPE (TREE_TYPE (TREE_OPERAND (t, 0)));
+
+      for (type = TYPE_ARG_TYPES (fntype); type; type = TREE_CHAIN (type))
+	if (POINTER_TYPE_P (TREE_VALUE (type))
+	    && (!data->lhs_base_decl || TREE_ADDRESSABLE (data->lhs_base_decl))
+	    && alias_sets_conflict_p (data->lhs_alias_set,
+				      get_alias_set
+				        (TREE_TYPE (TREE_VALUE (type)))))
+	  return t;
+    }
+
   if (IS_TYPE_OR_DECL_P (t))
     *walk_subtrees = 0;
   return NULL;
@@ -3061,6 +3061,20 @@ gimplify_init_constructor (tree *expr_p,
 	      }
 	  }
 
+	/* If there are nonzero elements, pre-evaluate to capture elements
+	   overlapping with the lhs into temporaries.  We must do this before
+	   clearing to fetch the values before they are zeroed-out.  */
+	if (num_nonzero_elements > 0)
+	  {
+	    preeval_data.lhs_base_decl = get_base_address (object);
+	    if (!DECL_P (preeval_data.lhs_base_decl))
+	      preeval_data.lhs_base_decl = NULL;
+	    preeval_data.lhs_alias_set = get_alias_set (object);
+
+	    gimplify_init_ctor_preeval (&TREE_OPERAND (*expr_p, 1),
+					pre_p, post_p, &preeval_data);
+	  }
+
 	if (cleared)
 	  {
 	    /* Zap the CONSTRUCTOR element list, which simplifies this case.
@@ -3076,16 +3090,7 @@ gimplify_init_constructor (tree *expr_p,
 	   elements in the constructor, add assignments to the individual
 	   scalar fields of the object.  */
 	if (!cleared || num_nonzero_elements > 0)
-	  {
-	    preeval_data.lhs_base_decl = get_base_address (object);
-	    if (!DECL_P (preeval_data.lhs_base_decl))
-	      preeval_data.lhs_base_decl = NULL;
-	    preeval_data.lhs_alias_set = get_alias_set (object);
-
-	    gimplify_init_ctor_preeval (&TREE_OPERAND (*expr_p, 1),
-					pre_p, post_p, &preeval_data);
-	    gimplify_init_ctor_eval (object, elts, pre_p, cleared);
-	  }
+	  gimplify_init_ctor_eval (object, elts, pre_p, cleared);
 
 	*expr_p = NULL_TREE;
       }
--- gcc/testsuite/gcc.c-torture/execute/20071202-1.c.jj	2007-12-02 19:26:19.000000000 +0100
+++ gcc/testsuite/gcc.c-torture/execute/20071202-1.c	2007-12-02 19:24:28.000000000 +0100
@@ -0,0 +1,25 @@
+extern void abort (void);
+struct T { int t; int r[8]; };
+struct S { int a; int b; int c[6]; struct T d; };
+
+__attribute__((noinline)) void
+foo (struct S *s)
+{
+  *s = (struct S) { s->b, s->a, { 0, 0, 0, 0, 0, 0 }, s->d };
+}
+
+int
+main (void)
+{
+  struct S s = { 6, 12, { 1, 2, 3, 4, 5, 6 },
+		 { 7, { 8, 9, 10, 11, 12, 13, 14, 15 } } };
+  foo (&s);
+  if (s.a != 12 || s.b != 6
+      || s.c[0] || s.c[1] || s.c[2] || s.c[3] || s.c[4] || s.c[5])
+    abort ();
+  if (s.d.t != 7 || s.d.r[0] != 8 || s.d.r[1] != 9 || s.d.r[2] != 10
+      || s.d.r[3] != 11 || s.d.r[4] != 12 || s.d.r[5] != 13
+      || s.d.r[6] != 14 || s.d.r[7] != 15)
+    abort ();
+  return 0;
+}
--- gcc/testsuite/gnat.dg/self_aggregate_with_zeros.adb	(revision 0)
+++ gcc/testsuite/gnat.dg/self_aggregate_with_zeros.adb	(revision 116300)
@@ -0,0 +1,19 @@
+-- { dg-do run }
+
+procedure self_aggregate_with_zeros is
+
+   type Sensor is record
+      Value  : Natural;
+      A, B, C, D, E, F, G, H, I, J, K, L, M : Natural;
+   end record;
+
+   Pressure : Sensor;
+
+begin
+   Pressure.Value := 256;
+   Pressure := (Pressure.Value, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
+
+   if Pressure.Value /= 256 then
+      raise Program_Error;
+   end if;
+end;
--- gcc/testsuite/gnat.dg/self_aggregate_with_array.adb	(revision 0)
+++ gcc/testsuite/gnat.dg/self_aggregate_with_array.adb	(revision 116300)
@@ -0,0 +1,21 @@
+-- { dg-do run }
+
+procedure self_aggregate_with_array is
+
+   type Value_Bounds is array (1 .. 2) of Natural;
+
+   type Sensor is record
+      Value  : Natural;
+      Bounds : Value_Bounds;
+   end record;
+
+   Pressure : Sensor;
+
+begin
+   Pressure.Value := 256;
+   Pressure := (Value => Pressure.Value, Bounds => (1, 2));
+
+   if Pressure.Value /= 256 then
+      raise Program_Error;
+   end if;
+end;
--- gcc/testsuite/gnat.dg/self_aggregate_with_call.adb	(revision 0)
+++ gcc/testsuite/gnat.dg/self_aggregate_with_call.adb	(revision 122134)
@@ -0,0 +1,30 @@
+-- { dg-do run }
+-- { dg-options "-O2" }
+
+procedure self_aggregate_with_call is
+
+   type Values is array (1 .. 8) of Natural;
+
+   type Vector is record
+      Components : Values;
+   end record;
+
+   function Clone (Components: Values) return Values is
+   begin
+      return Components;
+   end;
+
+   procedure Process (V : in out Vector) is
+   begin
+      V.Components (Values'First) := 1;
+      V := (Components => Clone (V.Components));
+
+      if V.Components (Values'First) /= 1 then
+         raise Program_Error;
+      end if;
+   end;
+
+   V : Vector;
+begin
+   Process (V);
+end;