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

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

From-SVN: r122133

4 files changed, 54 insertions, 0 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index 6bf8954..0f834e4 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,8 @@
+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.
+
 2007-02-19  Richard Henderson  <rth@redhat.com>
 
         PR debug/29558
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index 34e6249..02eed6a 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -2628,6 +2628,21 @@ gimplify_init_ctor_preeval_1 (tree *tp, int *walk_subtrees, void *xdata)
       && 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 (CALL_EXPR_FN (t)));
+
+      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;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3633d7d..2101cee 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2007-02-19  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/self_aggregate_with_call.adb: New test.
+
 2007-02-18  Dorit Nuzman  <dorit@il.ibm.com>
 
 	PR tree-optimization/30975
diff --git a/gcc/testsuite/gnat.dg/self_aggregate_with_call.adb b/gcc/testsuite/gnat.dg/self_aggregate_with_call.adb
new file mode 100644
index 0000000..4979bd4
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/self_aggregate_with_call.adb
@@ -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;