From df10ee2a5a023ec7f9edf5961bec74b4aa475780 Mon Sep 17 00:00:00 2001
From: Eric Botcazou <ebotcazou@adacore.com>
Date: Mon, 19 Feb 2007 19:11:37 +0000
Subject: [PATCH] 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
---
gcc/ChangeLog | 5 ++++
gcc/gimplify.c | 15 ++++++++++
gcc/testsuite/ChangeLog | 4 +++
.../gnat.dg/self_aggregate_with_call.adb | 30 +++++++++++++++++++
4 files changed, 54 insertions(+)
create mode 100644 gcc/testsuite/gnat.dg/self_aggregate_with_call.adb
diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index 6bf895433e76..0f834e47b0e2 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 34e6249d2a26..02eed6aa9ad4 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 3633d7d1cf83..2101ceed194f 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 000000000000..4979bd4fc022
--- /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;
--
GitLab